This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PUSHSUB: make retop a parameter
[perl5.git] / cop.h
CommitLineData
a0d0e21e 1/* cop.h
79072805 2 *
1129b882 3 * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
8622e0e2 4 * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others
79072805
LW
5 *
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
8 *
8622e0e2 9 * Control ops (cops) are one of the two ops OP_NEXTSTATE and OP_DBSTATE,
775e5718 10 * that (loosely speaking) are statement separators.
3ffa1527
JH
11 * They hold information important for lexical state and error reporting.
12 * At run time, PL_curcop is set to point to the most recently executed cop,
a3985cdc 13 * and thus can be used to determine our current state.
79072805
LW
14 */
15
0d2925a6 16/* A jmpenv packages the state required to perform a proper non-local jump.
1c98cc53
DM
17 * Note that there is a PL_start_env initialized when perl starts, and
18 * PL_top_env points to this initially, so PL_top_env should always be
19 * non-null.
0d2925a6 20 *
1c98cc53
DM
21 * Existence of a non-null PL_top_env->je_prev implies it is valid to call
22 * longjmp() at that runlevel (we make sure PL_start_env.je_prev is always
0d2925a6
DM
23 * null to ensure this).
24 *
25 * je_mustcatch, when set at any runlevel to TRUE, means eval ops must
26 * establish a local jmpenv to handle exception traps. Care must be taken
27 * to restore the previous value of je_mustcatch before exiting the
28 * stack frame iff JMPENV_PUSH was not called in that stack frame.
29 * GSAR 97-03-27
30 */
31
32struct jmpenv {
33 struct jmpenv * je_prev;
caa674f3 34 Sigjmp_buf je_buf; /* uninit if je_prev is NULL */
0d2925a6
DM
35 int je_ret; /* last exception thrown */
36 bool je_mustcatch; /* need to call longjmp()? */
a68090fe 37 U16 je_old_delaymagic; /* saved PL_delaymagic */
0d2925a6
DM
38};
39
40typedef struct jmpenv JMPENV;
41
0d2925a6
DM
42/*
43 * How to build the first jmpenv.
44 *
45 * top_env needs to be non-zero. It points to an area
46 * in which longjmp() stuff is stored, as C callstack
47 * info there at least is thread specific this has to
48 * be per-thread. Otherwise a 'die' in a thread gives
49 * that thread the C stack of last thread to do an eval {}!
50 */
51
52#define JMPENV_BOOTSTRAP \
53 STMT_START { \
caa674f3
DD
54 PERL_POISON_EXPR(PoisonNew(&PL_start_env, 1, JMPENV));\
55 PL_top_env = &PL_start_env; \
56 PL_start_env.je_prev = NULL; \
0d2925a6
DM
57 PL_start_env.je_ret = -1; \
58 PL_start_env.je_mustcatch = TRUE; \
a68090fe 59 PL_start_env.je_old_delaymagic = 0; \
0d2925a6
DM
60 } STMT_END
61
62/*
63 * PERL_FLEXIBLE_EXCEPTIONS
64 *
65 * All the flexible exceptions code has been removed.
66 * See the following threads for details:
67 *
68 * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-07/msg00378.html
69 *
70 * Joshua's original patches (which weren't applied) and discussion:
71 *
72 * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01396.html
73 * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01489.html
74 * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01491.html
75 * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01608.html
76 * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02144.html
77 * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02998.html
78 *
79 * Chip's reworked patch and discussion:
80 *
81 * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1999-03/msg00520.html
82 *
83 * The flaw in these patches (which went unnoticed at the time) was
84 * that they moved some code that could potentially die() out of the
85 * region protected by the setjmp()s. This caused exceptions within
86 * END blocks and such to not be handled by the correct setjmp().
87 *
88 * The original patches that introduces flexible exceptions were:
89 *
ff7e9008
MS
90 * http://perl5.git.perl.org/perl.git/commit/312caa8e97f1c7ee342a9895c2f0e749625b4929
91 * http://perl5.git.perl.org/perl.git/commit/14dd3ad8c9bf82cf09798a22cc89a9862dfd6d1a
92 *
0d2925a6
DM
93 */
94
95#define dJMPENV JMPENV cur_env
96
97#define JMPENV_PUSH(v) \
98 STMT_START { \
1c98cc53
DM
99 DEBUG_l({ \
100 int i = 0; JMPENV *p = PL_top_env; \
101 while (p) { i++; p = p->je_prev; } \
91e35ba1
DM
102 Perl_deb(aTHX_ "JUMPENV_PUSH level=%d at %s:%d\n", \
103 i, __FILE__, __LINE__);}) \
0d2925a6 104 cur_env.je_prev = PL_top_env; \
0d2925a6 105 cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK); \
0d2925a6
DM
106 PL_top_env = &cur_env; \
107 cur_env.je_mustcatch = FALSE; \
a68090fe 108 cur_env.je_old_delaymagic = PL_delaymagic; \
0d2925a6
DM
109 (v) = cur_env.je_ret; \
110 } STMT_END
111
112#define JMPENV_POP \
113 STMT_START { \
1c98cc53
DM
114 DEBUG_l({ \
115 int i = -1; JMPENV *p = PL_top_env; \
116 while (p) { i++; p = p->je_prev; } \
91e35ba1
DM
117 Perl_deb(aTHX_ "JUMPENV_POP level=%d at %s:%d\n", \
118 i, __FILE__, __LINE__);}) \
d3ab86be 119 assert(PL_top_env == &cur_env); \
a68090fe 120 PL_delaymagic = cur_env.je_old_delaymagic; \
0d2925a6
DM
121 PL_top_env = cur_env.je_prev; \
122 } STMT_END
123
124#define JMPENV_JUMP(v) \
125 STMT_START { \
1c98cc53
DM
126 DEBUG_l({ \
127 int i = -1; JMPENV *p = PL_top_env; \
128 while (p) { i++; p = p->je_prev; } \
91e35ba1
DM
129 Perl_deb(aTHX_ "JUMPENV_JUMP(%d) level=%d at %s:%d\n", \
130 (int)v, i, __FILE__, __LINE__);}) \
0d2925a6
DM
131 if (PL_top_env->je_prev) \
132 PerlProc_longjmp(PL_top_env->je_buf, (v)); \
133 if ((v) == 2) \
37038d91 134 PerlProc_exit(STATUS_EXIT); \
5637ef5b 135 PerlIO_printf(PerlIO_stderr(), "panic: top_env, v=%d\n", (int)v); \
0d2925a6
DM
136 PerlProc_exit(1); \
137 } STMT_END
138
139#define CATCH_GET (PL_top_env->je_mustcatch)
1c98cc53
DM
140#define CATCH_SET(v) \
141 STMT_START { \
142 DEBUG_l( \
143 Perl_deb(aTHX_ \
144 "JUMPLEVEL set catch %d => %d (for %p) at %s:%d\n", \
145 PL_top_env->je_mustcatch, v, (void*)PL_top_env, \
146 __FILE__, __LINE__);) \
147 PL_top_env->je_mustcatch = (v); \
148 } STMT_END
0d2925a6 149
20439bc7
Z
150/*
151=head1 COP Hint Hashes
152*/
153
154typedef struct refcounted_he COPHH;
155
156#define COPHH_KEY_UTF8 REFCOUNTED_HE_KEY_UTF8
157
158/*
ffd08bbf 159=for apidoc Amx|SV *|cophh_fetch_pvn|const COPHH *cophh|const char *keypv|STRLEN keylen|U32 hash|U32 flags
20439bc7 160
2d7f6611
KW
161Look up the entry in the cop hints hash C<cophh> with the key specified by
162C<keypv> and C<keylen>. If C<flags> has the C<COPHH_KEY_UTF8> bit set,
20439bc7 163the key octets are interpreted as UTF-8, otherwise they are interpreted
2d7f6611 164as Latin-1. C<hash> is a precomputed hash of the key string, or zero if
20439bc7
Z
165it has not been precomputed. Returns a mortal scalar copy of the value
166associated with the key, or C<&PL_sv_placeholder> if there is no value
167associated with the key.
168
169=cut
170*/
171
172#define cophh_fetch_pvn(cophh, keypv, keylen, hash, flags) \
173 Perl_refcounted_he_fetch_pvn(aTHX_ cophh, keypv, keylen, hash, flags)
174
175/*
ffd08bbf 176=for apidoc Amx|SV *|cophh_fetch_pvs|const COPHH *cophh|const char *key|U32 flags
20439bc7
Z
177
178Like L</cophh_fetch_pvn>, but takes a literal string instead of a
179string/length pair, and no precomputed hash.
180
181=cut
182*/
183
184#define cophh_fetch_pvs(cophh, key, flags) \
185 Perl_refcounted_he_fetch_pvn(aTHX_ cophh, STR_WITH_LEN(key), 0, flags)
186
187/*
ffd08bbf 188=for apidoc Amx|SV *|cophh_fetch_pv|const COPHH *cophh|const char *key|U32 hash|U32 flags
20439bc7
Z
189
190Like L</cophh_fetch_pvn>, but takes a nul-terminated string instead of
191a string/length pair.
192
193=cut
194*/
195
196#define cophh_fetch_pv(cophh, key, hash, flags) \
197 Perl_refcounted_he_fetch_pv(aTHX_ cophh, key, hash, flags)
198
199/*
ffd08bbf 200=for apidoc Amx|SV *|cophh_fetch_sv|const COPHH *cophh|SV *key|U32 hash|U32 flags
20439bc7
Z
201
202Like L</cophh_fetch_pvn>, but takes a Perl scalar instead of a
203string/length pair.
204
205=cut
206*/
207
208#define cophh_fetch_sv(cophh, key, hash, flags) \
209 Perl_refcounted_he_fetch_sv(aTHX_ cophh, key, hash, flags)
210
211/*
ffd08bbf 212=for apidoc Amx|HV *|cophh_2hv|const COPHH *cophh|U32 flags
20439bc7
Z
213
214Generates and returns a standard Perl hash representing the full set of
2d7f6611 215key/value pairs in the cop hints hash C<cophh>. C<flags> is currently
20439bc7
Z
216unused and must be zero.
217
218=cut
219*/
220
221#define cophh_2hv(cophh, flags) \
222 Perl_refcounted_he_chain_2hv(aTHX_ cophh, flags)
223
224/*
ffd08bbf 225=for apidoc Amx|COPHH *|cophh_copy|COPHH *cophh
20439bc7 226
2d7f6611 227Make and return a complete copy of the cop hints hash C<cophh>.
20439bc7
Z
228
229=cut
230*/
231
232#define cophh_copy(cophh) Perl_refcounted_he_inc(aTHX_ cophh)
233
234/*
ffd08bbf 235=for apidoc Amx|void|cophh_free|COPHH *cophh
20439bc7 236
2d7f6611 237Discard the cop hints hash C<cophh>, freeing all resources associated
20439bc7
Z
238with it.
239
240=cut
241*/
242
243#define cophh_free(cophh) Perl_refcounted_he_free(aTHX_ cophh)
244
245/*
ffd08bbf 246=for apidoc Amx|COPHH *|cophh_new_empty
20439bc7
Z
247
248Generate and return a fresh cop hints hash containing no entries.
249
250=cut
251*/
252
253#define cophh_new_empty() ((COPHH *)NULL)
254
255/*
ffd08bbf 256=for apidoc Amx|COPHH *|cophh_store_pvn|COPHH *cophh|const char *keypv|STRLEN keylen|U32 hash|SV *value|U32 flags
20439bc7 257
2d7f6611 258Stores a value, associated with a key, in the cop hints hash C<cophh>,
20439bc7
Z
259and returns the modified hash. The returned hash pointer is in general
260not the same as the hash pointer that was passed in. The input hash is
261consumed by the function, and the pointer to it must not be subsequently
262used. Use L</cophh_copy> if you need both hashes.
263
2d7f6611 264The key is specified by C<keypv> and C<keylen>. If C<flags> has the
20439bc7 265C<COPHH_KEY_UTF8> bit set, the key octets are interpreted as UTF-8,
2d7f6611 266otherwise they are interpreted as Latin-1. C<hash> is a precomputed
20439bc7
Z
267hash of the key string, or zero if it has not been precomputed.
268
2d7f6611 269C<value> is the scalar value to store for this key. C<value> is copied
20439bc7
Z
270by this function, which thus does not take ownership of any reference
271to it, and later changes to the scalar will not be reflected in the
272value visible in the cop hints hash. Complex types of scalar will not
273be stored with referential integrity, but will be coerced to strings.
274
275=cut
276*/
277
278#define cophh_store_pvn(cophh, keypv, keylen, hash, value, flags) \
279 Perl_refcounted_he_new_pvn(aTHX_ cophh, keypv, keylen, hash, value, flags)
280
281/*
ffd08bbf 282=for apidoc Amx|COPHH *|cophh_store_pvs|const COPHH *cophh|const char *key|SV *value|U32 flags
20439bc7
Z
283
284Like L</cophh_store_pvn>, but takes a literal string instead of a
285string/length pair, and no precomputed hash.
286
287=cut
288*/
289
290#define cophh_store_pvs(cophh, key, value, flags) \
291 Perl_refcounted_he_new_pvn(aTHX_ cophh, STR_WITH_LEN(key), 0, value, flags)
292
293/*
ffd08bbf 294=for apidoc Amx|COPHH *|cophh_store_pv|const COPHH *cophh|const char *key|U32 hash|SV *value|U32 flags
20439bc7
Z
295
296Like L</cophh_store_pvn>, but takes a nul-terminated string instead of
297a string/length pair.
298
299=cut
300*/
301
302#define cophh_store_pv(cophh, key, hash, value, flags) \
303 Perl_refcounted_he_new_pv(aTHX_ cophh, key, hash, value, flags)
304
305/*
ffd08bbf 306=for apidoc Amx|COPHH *|cophh_store_sv|const COPHH *cophh|SV *key|U32 hash|SV *value|U32 flags
20439bc7
Z
307
308Like L</cophh_store_pvn>, but takes a Perl scalar instead of a
309string/length pair.
310
311=cut
312*/
313
314#define cophh_store_sv(cophh, key, hash, value, flags) \
315 Perl_refcounted_he_new_sv(aTHX_ cophh, key, hash, value, flags)
316
317/*
ffd08bbf 318=for apidoc Amx|COPHH *|cophh_delete_pvn|COPHH *cophh|const char *keypv|STRLEN keylen|U32 hash|U32 flags
20439bc7 319
2d7f6611 320Delete a key and its associated value from the cop hints hash C<cophh>,
20439bc7
Z
321and returns the modified hash. The returned hash pointer is in general
322not the same as the hash pointer that was passed in. The input hash is
323consumed by the function, and the pointer to it must not be subsequently
324used. Use L</cophh_copy> if you need both hashes.
325
2d7f6611 326The key is specified by C<keypv> and C<keylen>. If C<flags> has the
20439bc7 327C<COPHH_KEY_UTF8> bit set, the key octets are interpreted as UTF-8,
2d7f6611 328otherwise they are interpreted as Latin-1. C<hash> is a precomputed
20439bc7
Z
329hash of the key string, or zero if it has not been precomputed.
330
331=cut
332*/
333
334#define cophh_delete_pvn(cophh, keypv, keylen, hash, flags) \
335 Perl_refcounted_he_new_pvn(aTHX_ cophh, keypv, keylen, hash, \
336 (SV *)NULL, flags)
337
338/*
ffd08bbf 339=for apidoc Amx|COPHH *|cophh_delete_pvs|const COPHH *cophh|const char *key|U32 flags
20439bc7
Z
340
341Like L</cophh_delete_pvn>, but takes a literal string instead of a
342string/length pair, and no precomputed hash.
343
344=cut
345*/
346
347#define cophh_delete_pvs(cophh, key, flags) \
348 Perl_refcounted_he_new_pvn(aTHX_ cophh, STR_WITH_LEN(key), 0, \
349 (SV *)NULL, flags)
350
351/*
ffd08bbf 352=for apidoc Amx|COPHH *|cophh_delete_pv|const COPHH *cophh|const char *key|U32 hash|U32 flags
20439bc7
Z
353
354Like L</cophh_delete_pvn>, but takes a nul-terminated string instead of
355a string/length pair.
356
357=cut
358*/
359
360#define cophh_delete_pv(cophh, key, hash, flags) \
361 Perl_refcounted_he_new_pv(aTHX_ cophh, key, hash, (SV *)NULL, flags)
362
363/*
ffd08bbf 364=for apidoc Amx|COPHH *|cophh_delete_sv|const COPHH *cophh|SV *key|U32 hash|U32 flags
20439bc7
Z
365
366Like L</cophh_delete_pvn>, but takes a Perl scalar instead of a
367string/length pair.
368
369=cut
370*/
371
372#define cophh_delete_sv(cophh, key, hash, flags) \
373 Perl_refcounted_he_new_sv(aTHX_ cophh, key, hash, (SV *)NULL, flags)
0d2925a6 374
5ac1e9b2 375#include "mydtrace.h"
0d2925a6 376
88df5f01
FC
377struct cop {
378 BASEOP
379 /* On LP64 putting this here takes advantage of the fact that BASEOP isn't
380 an exact multiple of 8 bytes to save structure padding. */
381 line_t cop_line; /* line # of this command */
382 /* label for this construct is now stored in cop_hints_hash */
57843af0 383#ifdef USE_ITHREADS
88df5f01
FC
384 PADOFFSET cop_stashoff; /* offset into PL_stashpad, for the
385 package the line was compiled in */
1dc74fdb 386 char * cop_file; /* file name the following line # is from */
57843af0 387#else
88df5f01 388 HV * cop_stash; /* package line was compiled in */
79072805 389 GV * cop_filegv; /* file the following line # is from */
57843af0 390#endif
88df5f01
FC
391 U32 cop_hints; /* hints bits from pragmata */
392 U32 cop_seq; /* parse sequence number */
393 /* Beware. mg.c and warnings.pl assume the type of this is STRLEN *: */
394 STRLEN * cop_warnings; /* lexical warnings bitmask */
395 /* compile time state of %^H. See the comment in op.c for how this is
396 used to recreate a hash to return from caller. */
20439bc7 397 COPHH * cop_hints_hash;
79072805
LW
398};
399
57843af0 400#ifdef USE_ITHREADS
1dc74fdb
FC
401# define CopFILE(c) ((c)->cop_file)
402# define CopFILEGV(c) (CopFILE(c) \
403 ? gv_fetchfile(CopFILE(c)) : NULL)
404
405# ifdef NETWARE
406# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
d166b3ad 407# define CopFILE_setn(c,pv,l) ((c)->cop_file = savepvn((pv),(l)))
1dc74fdb
FC
408# else
409# define CopFILE_set(c,pv) ((c)->cop_file = savesharedpv(pv))
410# define CopFILE_setn(c,pv,l) ((c)->cop_file = savesharedpvn((pv),(l)))
411# endif
412
413# define CopFILESV(c) (CopFILE(c) \
414 ? GvSV(gv_fetchfile(CopFILE(c))) : NULL)
415# define CopFILEAV(c) (CopFILE(c) \
416 ? GvAV(gv_fetchfile(CopFILE(c))) : NULL)
417# define CopFILEAVx(c) (assert_(CopFILE(c)) \
418 GvAV(gv_fetchfile(CopFILE(c))))
083fcd59 419
d4d03940
FC
420# define CopSTASH(c) PL_stashpad[(c)->cop_stashoff]
421# define CopSTASH_set(c,hv) ((c)->cop_stashoff = (hv) \
422 ? alloccopstash(hv) \
423 : 0)
1dc74fdb
FC
424# ifdef NETWARE
425# define CopFILE_free(c) SAVECOPFILE_FREE(c)
426# else
427# define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = NULL))
428# endif
57843af0
GS
429#else
430# define CopFILEGV(c) ((c)->cop_filegv)
f4dd75d9 431# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
1dc74fdb
FC
432# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
433# define CopFILE_setn(c,pv,l) CopFILEGV_set((c), gv_fetchfile_flags((pv),(l),0))
434# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : NULL)
435# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : NULL)
436# ifdef DEBUGGING
437# define CopFILEAVx(c) (assert(CopFILEGV(c)), GvAV(CopFILEGV(c)))
438# else
439# define CopFILEAVx(c) (GvAV(CopFILEGV(c)))
440# endif
441# define CopFILE(c) (CopFILEGV(c) \
442 ? GvNAME(CopFILEGV(c))+2 : NULL)
57843af0 443# define CopSTASH(c) ((c)->cop_stash)
f4dd75d9 444# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
a0714e2c 445# define CopFILE_free(c) (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL))
05ec9bb3 446
57843af0 447#endif /* USE_ITHREADS */
20439bc7 448
d4d03940
FC
449#define CopSTASHPV(c) (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : NULL)
450 /* cop_stash is not refcounted */
451#define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
452#define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
d4d03940 453
20439bc7
Z
454#define CopHINTHASH_get(c) ((COPHH*)((c)->cop_hints_hash))
455#define CopHINTHASH_set(c,h) ((c)->cop_hints_hash = (h))
456
457/*
458=head1 COP Hint Reading
459*/
460
461/*
462=for apidoc Am|SV *|cop_hints_fetch_pvn|const COP *cop|const char *keypv|STRLEN keylen|U32 hash|U32 flags
463
2d7f6611
KW
464Look up the hint entry in the cop C<cop> with the key specified by
465C<keypv> and C<keylen>. If C<flags> has the C<COPHH_KEY_UTF8> bit set,
20439bc7 466the key octets are interpreted as UTF-8, otherwise they are interpreted
2d7f6611 467as Latin-1. C<hash> is a precomputed hash of the key string, or zero if
20439bc7
Z
468it has not been precomputed. Returns a mortal scalar copy of the value
469associated with the key, or C<&PL_sv_placeholder> if there is no value
470associated with the key.
471
472=cut
473*/
474
475#define cop_hints_fetch_pvn(cop, keypv, keylen, hash, flags) \
476 cophh_fetch_pvn(CopHINTHASH_get(cop), keypv, keylen, hash, flags)
477
478/*
479=for apidoc Am|SV *|cop_hints_fetch_pvs|const COP *cop|const char *key|U32 flags
480
481Like L</cop_hints_fetch_pvn>, but takes a literal string instead of a
482string/length pair, and no precomputed hash.
483
484=cut
485*/
486
487#define cop_hints_fetch_pvs(cop, key, flags) \
488 cophh_fetch_pvs(CopHINTHASH_get(cop), key, flags)
489
490/*
491=for apidoc Am|SV *|cop_hints_fetch_pv|const COP *cop|const char *key|U32 hash|U32 flags
492
493Like L</cop_hints_fetch_pvn>, but takes a nul-terminated string instead
494of a string/length pair.
495
496=cut
497*/
498
499#define cop_hints_fetch_pv(cop, key, hash, flags) \
500 cophh_fetch_pv(CopHINTHASH_get(cop), key, hash, flags)
501
502/*
503=for apidoc Am|SV *|cop_hints_fetch_sv|const COP *cop|SV *key|U32 hash|U32 flags
504
505Like L</cop_hints_fetch_pvn>, but takes a Perl scalar instead of a
506string/length pair.
507
508=cut
509*/
510
511#define cop_hints_fetch_sv(cop, key, hash, flags) \
512 cophh_fetch_sv(CopHINTHASH_get(cop), key, hash, flags)
513
514/*
515=for apidoc Am|HV *|cop_hints_2hv|const COP *cop|U32 flags
516
517Generates and returns a standard Perl hash representing the full set of
2d7f6611 518hint entries in the cop C<cop>. C<flags> is currently unused and must
20439bc7
Z
519be zero.
520
521=cut
522*/
523
524#define cop_hints_2hv(cop, flags) \
525 cophh_2hv(CopHINTHASH_get(cop), flags)
526
aebc0cbe 527#define CopLABEL(c) Perl_cop_fetch_label(aTHX_ (c), NULL, NULL)
5db1eb8d
BF
528#define CopLABEL_len(c,len) Perl_cop_fetch_label(aTHX_ (c), len, NULL)
529#define CopLABEL_len_flags(c,len,flags) Perl_cop_fetch_label(aTHX_ (c), len, flags)
dca6062a 530#define CopLABEL_alloc(pv) ((pv)?savepv(pv):NULL)
57843af0 531
ed094faf 532#define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv))
cc49e20b 533#define CopLINE(c) ((c)->cop_line)
57843af0
GS
534#define CopLINE_inc(c) (++CopLINE(c))
535#define CopLINE_dec(c) (--CopLINE(c))
536#define CopLINE_set(c,l) (CopLINE(c) = (l))
cc49e20b 537
248c2a4d 538/* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */
e37778c2 539#define OutCopFILE(c) CopFILE(c)
248c2a4d 540
d5ec2987 541#define CopHINTS_get(c) ((c)->cop_hints + 0)
623e6609 542#define CopHINTS_set(c, h) STMT_START { \
d5ec2987 543 (c)->cop_hints = (h); \
623e6609
NC
544 } STMT_END
545
79072805
LW
546/*
547 * Here we have some enormously heavy (or at least ponderous) wizardry.
548 */
549
550/* subroutine context */
551struct block_sub {
f9c764c5 552 OP * retop; /* op to execute on exit from sub */
adcbf118 553 /* Above here is the same for sub, format and eval. */
9aa350eb 554 PAD *prevcomppad; /* the caller's PL_comppad */
8e663997 555 CV * cv;
f9c764c5 556 /* Above here is the same for sub and format. */
bb172083 557 I32 olddepth;
3073d04f 558 AV *savearray;
f9c764c5
NC
559};
560
561
562/* format context */
563struct block_format {
f39bc417 564 OP * retop; /* op to execute on exit from sub */
adcbf118 565 /* Above here is the same for sub, format and eval. */
9aa350eb 566 PAD *prevcomppad; /* the caller's PL_comppad */
8e663997 567 CV * cv;
f9c764c5
NC
568 /* Above here is the same for sub and format. */
569 GV * gv;
570 GV * dfoutgv;
79072805
LW
571};
572
4ebe6e95
DM
573/* return a pointer to the current context */
574
575#define CX_CUR() (&cxstack[cxstack_ix])
576
dfe0f39b
DM
577/* free all savestack items back to the watermark of the specified context */
578
e992140c 579#define CX_LEAVE_SCOPE(cx) LEAVE_SCOPE(cx->blk_oldsaveix)
dfe0f39b 580
5da525e9
DM
581#ifdef DEBUGGING
582/* on debugging builds, poison cx afterwards so we know no code
583 * uses it - because after doing cxstack_ix--, any ties, exceptions etc
584 * may overwrite the current stack frame */
585# define CX_POP(cx) \
4ebe6e95 586 assert(CX_CUR() == cx); \
5da525e9
DM
587 cxstack_ix--; \
588 cx = NULL;
589#else
590# define CX_POP(cx) cxstack_ix--;
591#endif
592
593
b36bdeca 594/* base for the next two macros. Don't use directly.
d6911e1b
DM
595 * The context frame holds a reference to the CV so that it can't be
596 * freed while we're executing it */
b36bdeca 597
ceb12bd8 598#define PUSHSUB_BASE(cx, cv, op, hasargs) \
88dbe4af
FC
599 ENTRY_PROBE(CvNAMED(cv) \
600 ? HEK_KEY(CvNAME_HEK(cv)) \
601 : GvENAME(CvGV(cv)), \
c6903450 602 CopFILE((const COP *)CvSTART(cv)), \
3e2413e5
DL
603 CopLINE((const COP *)CvSTART(cv)), \
604 CopSTASHPV((const COP *)CvSTART(cv))); \
5ac1e9b2 605 \
79072805 606 cx->blk_sub.cv = cv; \
b8f55b69 607 cx->blk_sub.olddepth = CvDEPTH(cv); \
3b21fb5d 608 cx->blk_sub.prevcomppad = PL_comppad; \
ae423868 609 cx->cx_type |= (hasargs) ? CXp_HASARGS : 0; \
ceb12bd8 610 cx->blk_sub.retop = op; \
94a11f7c 611 SvREFCNT_inc_simple_void_NN(cv);
b36bdeca 612
4587c532 613#define PUSHSUB_GET_LVALUE_MASK(func) \
777d9014
FC
614 /* If the context is indeterminate, then only the lvalue */ \
615 /* flags that the caller also has are applicable. */ \
4587c532 616 ( \
777d9014
FC
617 (PL_op->op_flags & OPf_WANT) \
618 ? OPpENTERSUB_LVAL_MASK \
619 : !(PL_op->op_private & OPpENTERSUB_LVAL_MASK) \
4587c532
FC
620 ? 0 : (U8)func(aTHX) \
621 )
622
ceb12bd8 623#define PUSHSUB(cx, cv, op, hasargs) \
4587c532
FC
624 { \
625 U8 phlags = PUSHSUB_GET_LVALUE_MASK(Perl_was_lvalue_sub); \
ceb12bd8 626 PUSHSUB_BASE(cx, cv, op, hasargs) \
446d0787 627 cx->blk_u16 = PL_op->op_private & \
0e9700df 628 (phlags|OPpDEREF); \
777d9014 629 }
79072805 630
ee98a1d6 631/* variant for use by OP_DBSTATE, where op_private holds hint bits */
ceb12bd8
DM
632#define PUSHSUB_DB(cx, cv, op, hasargs) \
633 PUSHSUB_BASE(cx, cv, op, hasargs) \
446d0787 634 cx->blk_u16 = 0;
ee98a1d6
DM
635
636
fb2f5dcb 637#define PUSHFORMAT(cx, cv, gv, retop) \
f9c764c5
NC
638 cx->blk_format.cv = cv; \
639 cx->blk_format.gv = gv; \
640 cx->blk_format.retop = (retop); \
f9c764c5 641 cx->blk_format.dfoutgv = PL_defoutgv; \
3b21fb5d 642 cx->blk_format.prevcomppad = PL_comppad; \
1956db7e 643 cx->blk_u16 = 0; \
2c50b7ed 644 SvREFCNT_inc_simple_void_NN(cv); \
f32c7e86 645 CvDEPTH(cv)++; \
f9c764c5 646 SvREFCNT_inc_void(cx->blk_format.dfoutgv)
79072805 647
fad386cb 648/* Restore old @_ */
b405d38b 649#define CX_POP_SAVEARRAY(cx) \
6d4ff0d2 650 STMT_START { \
fad386cb 651 AV *av = GvAV(PL_defgv); \
a8bba7fa 652 GvAV(PL_defgv) = cx->blk_sub.savearray; \
656457d0 653 cx->blk_sub.savearray = NULL; \
fad386cb 654 SvREFCNT_dec(av); \
6d4ff0d2 655 } STMT_END
6d4ff0d2 656
ecf8e9dd 657/* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't
8e09340b
GS
658 * leave any (a fast av_clear(ary), basically) */
659#define CLEAR_ARGARRAY(ary) \
660 STMT_START { \
661 AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary); \
9c6bc640 662 AvARRAY(ary) = AvALLOC(ary); \
8e09340b
GS
663 AvFILLp(ary) = -1; \
664 } STMT_END
7766f137 665
7e27c4a5 666
b405d38b 667/* subsets of CX_POPSUB */
7e27c4a5 668
b405d38b 669#define CX_POPSUB_COMMON(cx) \
656457d0
DM
670 STMT_START { \
671 CV *cv; \
e4592eb4 672 assert(CxTYPE(cx) == CXt_SUB); \
656457d0
DM
673 PL_comppad = cx->blk_sub.prevcomppad; \
674 PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; \
675 cv = cx->blk_sub.cv; \
676 CvDEPTH(cv) = cx->blk_sub.olddepth; \
677 cx->blk_sub.cv = NULL; \
678 SvREFCNT_dec(cv); \
679 } STMT_END
7e27c4a5 680
04e686b8
DM
681/* handle the @_ part of leaving a sub */
682
b405d38b 683#define CX_POPSUB_ARGS(cx) \
04e686b8
DM
684 STMT_START { \
685 AV *av; \
e4592eb4 686 assert(CxTYPE(cx) == CXt_SUB); \
04e686b8
DM
687 assert(AvARRAY(MUTABLE_AV( \
688 PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[ \
689 CvDEPTH(cx->blk_sub.cv)])) == PL_curpad); \
b405d38b 690 CX_POP_SAVEARRAY(cx); \
04e686b8
DM
691 av = MUTABLE_AV(PAD_SVl(0)); \
692 if (UNLIKELY(AvREAL(av))) \
e2b78548 693 /* abandon @_ if it got reified */ \
04e686b8
DM
694 clear_defarray(av, 0); \
695 else { \
696 CLEAR_ARGARRAY(av); \
697 } \
698 } STMT_END
7e27c4a5 699
b405d38b 700#define CX_POPSUB(cx) \
b0d9ce38 701 STMT_START { \
e4592eb4 702 assert(CxTYPE(cx) == CXt_SUB); \
88dbe4af
FC
703 RETURN_PROBE(CvNAMED(cx->blk_sub.cv) \
704 ? HEK_KEY(CvNAME_HEK(cx->blk_sub.cv)) \
705 : GvENAME(CvGV(cx->blk_sub.cv)), \
8f629a87 706 CopFILE((COP*)CvSTART((const CV*)cx->blk_sub.cv)), \
3e2413e5
DL
707 CopLINE((COP*)CvSTART((const CV*)cx->blk_sub.cv)), \
708 CopSTASHPV((COP*)CvSTART((const CV*)cx->blk_sub.cv))); \
5ac1e9b2 709 \
bafb2adc 710 if (CxHASARGS(cx)) { \
b405d38b 711 CX_POPSUB_ARGS(cx); \
79072805 712 } \
b405d38b 713 CX_POPSUB_COMMON(cx); \
b0d9ce38 714 } STMT_END
79072805 715
b405d38b 716#define CX_POPFORMAT(cx) \
25375124 717 STMT_START { \
656457d0
DM
718 CV *cv; \
719 GV * const dfout = cx->blk_format.dfoutgv; \
e4592eb4 720 assert(CxTYPE(cx) == CXt_FORMAT); \
656457d0
DM
721 setdefout(dfout); \
722 cx->blk_format.dfoutgv = NULL; \
723 SvREFCNT_dec_NN(dfout); /* the cx->defoutgv ref */ \
3b21fb5d
DM
724 PL_comppad = cx->blk_format.prevcomppad; \
725 PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; \
656457d0
DM
726 cv = cx->blk_format.cv; \
727 cx->blk_format.cv = NULL;; \
2c50b7ed 728 --CvDEPTH(cv); \
656457d0 729 SvREFCNT_dec_NN(cv); \
25375124 730 } STMT_END
79072805
LW
731
732/* eval context */
733struct block_eval {
8e663997
NC
734 OP * retop; /* op to execute on exit from eval */
735 /* Above here is the same for sub, format and eval. */
0f79a09d 736 SV * old_namesv;
79072805 737 OP * old_eval_root;
748a9306 738 SV * cur_text;
2090ab20 739 CV * cv;
abd70938 740 JMPENV * cur_top_env; /* value of PL_top_env when eval CX created */
79072805
LW
741};
742
17347a51
NC
743/* If we ever need more than 512 op types, change the shift from 7.
744 blku_gimme is actually also only 2 bits, so could be merged with something.
745*/
746
747#define CxOLD_IN_EVAL(cx) (((cx)->blk_u16) & 0x7F)
748#define CxOLD_OP_TYPE(cx) (((cx)->blk_u16) >> 7)
85a64632 749
274ed8ae 750#define PUSHEVAL(cx, op, n) \
0f79a09d 751 STMT_START { \
17347a51
NC
752 assert(!(PL_in_eval & ~0x7F)); \
753 assert(!(PL_op->op_type & ~0x1FF)); \
754 cx->blk_u16 = (PL_in_eval & 0x7F) | ((U16)PL_op->op_type << 7); \
a0714e2c 755 cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : NULL); \
a8bba7fa 756 cx->blk_eval.old_eval_root = PL_eval_root; \
bdc0bf6f 757 cx->blk_eval.cur_text = PL_parser ? PL_parser->linestr : NULL; \
9aba0c93 758 cx->blk_eval.cv = NULL; /* set by doeval_compile() as applicable */ \
274ed8ae 759 cx->blk_eval.retop = op; \
abd70938 760 cx->blk_eval.cur_top_env = PL_top_env; \
0f79a09d 761 } STMT_END
79072805 762
b405d38b 763#define CX_POPEVAL(cx) \
0f79a09d 764 STMT_START { \
f09cca8c 765 SV *sv; \
e4592eb4 766 assert(CxTYPE(cx) == CXt_EVAL); \
85a64632 767 PL_in_eval = CxOLD_IN_EVAL(cx); \
7766f137 768 PL_eval_root = cx->blk_eval.old_eval_root; \
f09cca8c
DM
769 sv = cx->blk_eval.cur_text; \
770 if (sv && SvSCREAM(sv)) { \
771 cx->blk_eval.cur_text = NULL; \
772 SvREFCNT_dec_NN(sv); \
773 } \
774 sv = cx->blk_eval.old_namesv; \
b405d38b 775 if (sv && !SvTEMP(sv))/* TEMP implies CX_POPEVAL re-entrantly called */ \
f09cca8c 776 sv_2mortal(sv); \
0f79a09d 777 } STMT_END
79072805
LW
778
779/* loop context */
780struct block_loop {
022eaa24 781 LOOP * my_op; /* My op, that contains redo, next and last ops. */
df530c37 782 union { /* different ways of locating the iteration variable */
b52de964
DM
783 SV **svp; /* for lexicals: address of pad slot */
784 GV *gv; /* for package vars */
df530c37 785 } itervar_u;
f0bb9bf7 786 SV *itersave; /* the original iteration var */
493b0a3c 787 union {
93661e56
DM
788 struct { /* CXt_LOOP_ARY, C<for (@ary)> */
789 AV *ary; /* array being iterated over */
790 IV ix; /* index relative to base of array */
d01136d6 791 } ary;
93661e56
DM
792 struct { /* CXt_LOOP_LIST, C<for (list)> */
793 I32 basesp; /* first element of list on stack */
794 IV ix; /* index relative to basesp */
795 } stack;
796 struct { /* CXt_LOOP_LAZYIV, C<for (1..9)> */
d01136d6
BS
797 IV cur;
798 IV end;
799 } lazyiv;
93661e56 800 struct { /* CXt_LOOP_LAZYSV C<for ('a'..'z')> */
d01136d6
BS
801 SV * cur;
802 SV * end; /* maxiumum value (or minimum in reverse) */
803 } lazysv;
804 } state_u;
7766f137 805#ifdef USE_ITHREADS
b52de964 806 PAD *oldcomppad; /* needed to map itervar_u.svp during thread clone */
f83b46a0 807#endif
b52de964 808};
f83b46a0 809
9af0df0b
DM
810#define CxITERVAR(c) \
811 (CxPADLOOP(c) \
812 ? (c)->blk_loop.itervar_u.svp \
813 : ((c)->cx_type & CXp_FOR_GV) \
814 ? &GvSV((c)->blk_loop.itervar_u.gv) \
815 : (SV **)&(c)->blk_loop.itervar_u.gv)
f83b46a0 816
b1cf8b36 817#define CxLABEL(c) (0 + CopLABEL((c)->blk_oldcop))
5db1eb8d
BF
818#define CxLABEL_len(c,len) (0 + CopLABEL_len((c)->blk_oldcop, len))
819#define CxLABEL_len_flags(c,len,flags) (0 + CopLABEL_len_flags((c)->blk_oldcop, len, flags))
ae423868 820#define CxHASARGS(c) (((c)->cx_type & CXp_HASARGS) == CXp_HASARGS)
d9203e03
DM
821
822/* CxLVAL(): the lval flags of the call site: the relevant flag bits from
823 * the op_private field of the calling pp_entersub (or its caller's caller
824 * if the caller's lvalue context isn't known):
825 * OPpLVAL_INTRO: sub used in lvalue context, e.g. f() = 1;
826 * OPpENTERSUB_INARGS (in conjunction with OPpLVAL_INTRO): the
827 * function is being used as a sub arg or as a referent, e.g.
828 * g(...,f(),...) or $r = \f()
829 * OPpDEREF: 2-bit mask indicating e.g. f()->[0].
830 * Note the contrast with CvLVALUE(), which is a property of the sub
831 * rather than the call site.
832 */
1956db7e 833#define CxLVAL(c) (0 + ((c)->blk_u16 & 0xff))
1956db7e 834
7766f137 835
1bef65a2 836#define PUSHLOOP_PLAIN(cx) \
47878d9c 837 cx->blk_loop.my_op = cLOOP;
3b719c58 838
b52de964
DM
839#ifdef USE_ITHREADS
840# define PUSHLOOP_FOR_setpad(c) (c)->blk_loop.oldcomppad = PL_comppad
841#else
842# define PUSHLOOP_FOR_setpad(c) NOOP
843#endif
844
1bef65a2 845#define PUSHLOOP_FOR(cx, ivar, isave) \
022eaa24 846 cx->blk_loop.my_op = cLOOP; \
b52de964 847 cx->blk_loop.itervar_u.svp = (SV**)(ivar); \
f0bb9bf7 848 cx->blk_loop.itersave = isave; \
b52de964 849 PUSHLOOP_FOR_setpad(cx);
79072805 850
b405d38b 851#define CX_POPLOOP(cx) \
e4592eb4 852 assert(CxTYPE_is_LOOP(cx)); \
113ebcf5
DM
853 if ( CxTYPE(cx) == CXt_LOOP_ARY \
854 || CxTYPE(cx) == CXt_LOOP_LAZYSV) \
855 { \
856 /* Free ary or cur. This assumes that state_u.ary.ary \
857 * aligns with state_u.lazysv.cur. See cx_dup() */ \
a7db2e35
DM
858 SV *sv = cx->blk_loop.state_u.lazysv.cur; \
859 cx->blk_loop.state_u.lazysv.cur = NULL; \
860 SvREFCNT_dec_NN(sv); \
113ebcf5
DM
861 if (CxTYPE(cx) == CXt_LOOP_LAZYSV) { \
862 sv = cx->blk_loop.state_u.lazysv.end; \
863 cx->blk_loop.state_u.lazysv.end = NULL; \
864 SvREFCNT_dec_NN(sv); \
865 } \
d01136d6 866 } \
9af0df0b 867 if (cx->cx_type & (CXp_FOR_PAD|CXp_FOR_GV)) { \
f0bb9bf7 868 SV *cursv; \
d4e2b4d6
DM
869 SV **svp = (cx)->blk_loop.itervar_u.svp; \
870 if ((cx->cx_type & CXp_FOR_GV)) \
f0bb9bf7 871 svp = &GvSV((GV*)svp); \
d4e2b4d6
DM
872 cursv = *svp; \
873 *svp = cx->blk_loop.itersave; \
a7db2e35 874 cx->blk_loop.itersave = NULL; \
385bbb12 875 SvREFCNT_dec(cursv); \
b042e328 876 }
79072805 877
0d863452
RH
878/* given/when context */
879struct block_givwhen {
880 OP *leave_op;
b95eccd3 881 SV *defsv_save; /* the original $_ */
0d863452
RH
882};
883
b95eccd3 884#define PUSHWHEN(cx) \
0d863452
RH
885 cx->blk_givwhen.leave_op = cLOGOP->op_other;
886
b95eccd3
DM
887#define PUSHGIVEN(cx, orig_var) \
888 PUSHWHEN(cx); \
889 cx->blk_givwhen.defsv_save = orig_var;
890
b405d38b 891#define CX_POPWHEN(cx) \
e4592eb4 892 assert(CxTYPE(cx) == CXt_WHEN); \
2f450c1b 893 NOOP;
b95eccd3 894
b405d38b 895#define CX_POPGIVEN(cx) \
33e0807a
DM
896 STMT_START { \
897 SV *sv = GvSV(PL_defgv); \
e4592eb4 898 assert(CxTYPE(cx) == CXt_GIVEN); \
33e0807a
DM
899 GvSV(PL_defgv) = cx->blk_givwhen.defsv_save; \
900 cx->blk_givwhen.defsv_save = NULL; \
901 SvREFCNT_dec(sv); \
902 } STMT_END
b95eccd3 903
0d863452 904
c5369ccc
DM
905/* basic block, i.e. pp_enter/leave */
906
dfe0f39b 907#define PUSHBASICBLK(cx) \
47878d9c 908 NOOP;
c5369ccc 909
b405d38b 910#define CX_POPBASICBLK(cx) \
e4592eb4 911 assert(CxTYPE(cx) == CXt_BLOCK); \
2f450c1b 912 NOOP;
c5369ccc
DM
913
914
79072805
LW
915/* context common to subroutines, evals and loops */
916struct block {
446d0787 917 U8 blku_type; /* what kind of context this is */
2e0df0e8 918 U8 blku_gimme; /* is this block running in list context? */
17347a51 919 U16 blku_u16; /* used by block_sub and block_eval (so far) */
e992140c
DM
920 I32 blku_oldsaveix; /* saved PL_savestack_ix */
921 /* all the fields above must be aligned with same-sized fields as sbu */
1bef65a2 922 I32 blku_oldsp; /* current sp floor: where nextstate pops to */
79072805 923 I32 blku_oldmarksp; /* mark stack index */
f284fecd 924 COP * blku_oldcop; /* old curcop pointer */
79072805 925 PMOP * blku_oldpm; /* values of pattern match vars */
bb3300d1 926 SSize_t blku_old_tmpsfloor; /* saved PL_tmps_floor */
f284fecd 927 I32 blku_oldscopesp; /* scope stack index */
79072805
LW
928
929 union {
930 struct block_sub blku_sub;
f9c764c5 931 struct block_format blku_format;
79072805
LW
932 struct block_eval blku_eval;
933 struct block_loop blku_loop;
0d863452 934 struct block_givwhen blku_givwhen;
79072805
LW
935 } blk_u;
936};
937#define blk_oldsp cx_u.cx_blk.blku_oldsp
938#define blk_oldcop cx_u.cx_blk.blku_oldcop
79072805
LW
939#define blk_oldmarksp cx_u.cx_blk.blku_oldmarksp
940#define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp
941#define blk_oldpm cx_u.cx_blk.blku_oldpm
942#define blk_gimme cx_u.cx_blk.blku_gimme
446d0787 943#define blk_u16 cx_u.cx_blk.blku_u16
e992140c 944#define blk_oldsaveix cx_u.cx_blk.blku_oldsaveix
79072805 945#define blk_sub cx_u.cx_blk.blk_u.blku_sub
f9c764c5 946#define blk_format cx_u.cx_blk.blk_u.blku_format
79072805
LW
947#define blk_eval cx_u.cx_blk.blk_u.blku_eval
948#define blk_loop cx_u.cx_blk.blk_u.blku_loop
0d863452 949#define blk_givwhen cx_u.cx_blk.blk_u.blku_givwhen
79072805 950
5e691bc6 951#define CX_DEBUG(cx, action) \
d9f81b50 952 DEBUG_l( \
bb3300d1 953 Perl_deb(aTHX_ "CX %ld %s %s (scope %ld,%ld) (save %ld,%ld) at %s:%d\n",\
1c98cc53
DM
954 (long)cxstack_ix, \
955 action, \
5e691bc6 956 PL_block_type[CxTYPE(cx)], \
1c98cc53 957 (long)PL_scopestack_ix, \
5e691bc6 958 (long)(cx->blk_oldscopesp), \
bb3300d1 959 (long)PL_savestack_ix, \
5e691bc6 960 (long)(cx->blk_oldsaveix), \
d9f81b50 961 __FILE__, __LINE__));
1c98cc53 962
79072805 963/* Enter a block. */
fd9b7244 964#define PUSHBLOCK(cx, t, gimme, sp, saveix) \
47878d9c
DM
965 CXINC, \
966 cx = CX_CUR(), \
79072805 967 cx->cx_type = t, \
3280af22
NIS
968 cx->blk_oldsp = sp - PL_stack_base, \
969 cx->blk_oldcop = PL_curcop, \
1aff0e91 970 cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \
47878d9c 971 cx->blk_oldsaveix = saveix, \
3280af22 972 cx->blk_oldscopesp = PL_scopestack_ix, \
3280af22 973 cx->blk_oldpm = PL_curpm, \
eb160463 974 cx->blk_gimme = (U8)gimme; \
94a11f7c
DM
975 cx->cx_u.cx_blk.blku_old_tmpsfloor = PL_tmps_floor; \
976 PL_tmps_floor = PL_tmps_ix; \
5e691bc6 977 CX_DEBUG(cx, "PUSH");
79072805 978
b405d38b 979#define _CX_POPBLOCK_COMMON(cx) \
2e17e9ad
DM
980 PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
981 PL_scopestack_ix = cx->blk_oldscopesp, \
982 PL_curpm = cx->blk_oldpm,
983
79072805 984/* Exit a block (RETURN and LAST). */
b405d38b 985#define CX_POPBLOCK(cx) \
5e691bc6 986 CX_DEBUG(cx, "POP"); \
b405d38b 987 _CX_POPBLOCK_COMMON(cx) \
72c5b62d
DM
988 /* LEAVE_SCOPE() should have made this true. /(?{})/ cheats
989 * and leaves a CX entry lying around for repeated use, so
990 * skip for multicall */ \
8e7e33ef 991 assert( (CxTYPE(cx) == CXt_SUB && CxMULTICALL(cx)) \
e992140c 992 || PL_savestack_ix == cx->blk_oldsaveix); \
2e17e9ad 993 PL_curcop = cx->blk_oldcop, \
b042e328 994 PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor; \
79072805 995
2e17e9ad 996/* Continue a block elsewhere (e.g. NEXT, REDO, GOTO).
b405d38b
DM
997 * Whereas CX_POPBLOCK restores the state to the point just before PUSHBLOCK
998 * was called, CX_TOPBLOCK restores it to the point just *after* PUSHBLOCK
2e17e9ad 999 * was called. */
b405d38b 1000#define CX_TOPBLOCK(cx) \
5e691bc6 1001 CX_DEBUG(cx, "TOP"); \
b405d38b 1002 _CX_POPBLOCK_COMMON(cx) \
2e17e9ad 1003 PL_stack_sp = PL_stack_base + cx->blk_oldsp;
79072805
LW
1004
1005/* substitution context */
1006struct subst {
e992140c 1007 U8 sbu_type; /* same as blku_type */
1ed74d04 1008 U8 sbu_rflags;
e992140c
DM
1009 U16 sbu_rxtainted;
1010 I32 sbu_oldsaveix; /* same as blku_oldsaveix */
a7f94955 1011 /* all the fields above must be aligned with same-sized fields as blk_u */
3c6ef0a5
FC
1012 SSize_t sbu_iters;
1013 SSize_t sbu_maxiters;
79072805
LW
1014 char * sbu_orig;
1015 SV * sbu_dstr;
1016 SV * sbu_targ;
1017 char * sbu_s;
1018 char * sbu_m;
1019 char * sbu_strend;
c90c0ff4 1020 void * sbu_rxres;
c07a80fd 1021 REGEXP * sbu_rx;
79072805
LW
1022};
1023#define sb_iters cx_u.cx_subst.sbu_iters
1024#define sb_maxiters cx_u.cx_subst.sbu_maxiters
22e551b9 1025#define sb_rflags cx_u.cx_subst.sbu_rflags
71be2cbc 1026#define sb_rxtainted cx_u.cx_subst.sbu_rxtainted
79072805
LW
1027#define sb_orig cx_u.cx_subst.sbu_orig
1028#define sb_dstr cx_u.cx_subst.sbu_dstr
1029#define sb_targ cx_u.cx_subst.sbu_targ
1030#define sb_s cx_u.cx_subst.sbu_s
1031#define sb_m cx_u.cx_subst.sbu_m
1032#define sb_strend cx_u.cx_subst.sbu_strend
c90c0ff4 1033#define sb_rxres cx_u.cx_subst.sbu_rxres
c07a80fd 1034#define sb_rx cx_u.cx_subst.sbu_rx
79072805 1035
9c105995 1036#ifdef PERL_CORE
4ebe6e95 1037# define PUSHSUBST(cx) CXINC, cx = CX_CUR(), \
e992140c 1038 cx->blk_oldsaveix = oldsave, \
79072805
LW
1039 cx->sb_iters = iters, \
1040 cx->sb_maxiters = maxiters, \
22e551b9 1041 cx->sb_rflags = r_flags, \
71be2cbc 1042 cx->sb_rxtainted = rxtainted, \
79072805
LW
1043 cx->sb_orig = orig, \
1044 cx->sb_dstr = dstr, \
1045 cx->sb_targ = targ, \
1046 cx->sb_s = s, \
1047 cx->sb_m = m, \
1048 cx->sb_strend = strend, \
4608196e 1049 cx->sb_rxres = NULL, \
c07a80fd 1050 cx->sb_rx = rx, \
1ed74d04 1051 cx->cx_type = CXt_SUBST | (once ? CXp_ONCE : 0); \
e22ae1e2 1052 rxres_save(&cx->sb_rxres, rx); \
cf69025f
TC
1053 (void)ReREFCNT_inc(rx); \
1054 SvREFCNT_inc_void_NN(targ)
79072805 1055
b405d38b 1056# define CX_POPSUBST(cx) \
77189b8c
DM
1057 STMT_START { \
1058 REGEXP *re; \
e4592eb4 1059 assert(CxTYPE(cx) == CXt_SUBST); \
e22ae1e2 1060 rxres_free(&cx->sb_rxres); \
77189b8c
DM
1061 re = cx->sb_rx; \
1062 cx->sb_rx = NULL; \
1063 ReREFCNT_dec(re); \
1064 SvREFCNT_dec_NN(cx->sb_targ); \
1065 } STMT_END
9c105995
NC
1066#endif
1067
1068#define CxONCE(cx) ((cx)->cx_type & CXp_ONCE)
79072805
LW
1069
1070struct context {
79072805
LW
1071 union {
1072 struct block cx_blk;
1073 struct subst cx_subst;
1074 } cx_u;
1075};
2e0df0e8 1076#define cx_type cx_u.cx_subst.sbu_type
6b35e009 1077
76753e7f
NC
1078/* If you re-order these, there is also an array of uppercase names in perl.h
1079 and a static array of context names in pp_ctl.c */
3701055e 1080#define CXTYPEMASK 0xf
79646418 1081#define CXt_NULL 0 /* currently only used for sort BLOCK */
76753e7f
NC
1082#define CXt_WHEN 1
1083#define CXt_BLOCK 2
1084/* When micro-optimising :-) keep GIVEN next to the LOOPs, as these 5 share a
1085 jump table in pp_ctl.c
1086 The first 4 don't have a 'case' in at least one switch statement in pp_ctl.c
1087*/
1088#define CXt_GIVEN 3
93661e56
DM
1089
1090/* be careful of the ordering of these five. Macros like CxTYPE_is_LOOP,
1091 * CxFOREACH compare ranges */
113ebcf5
DM
1092#define CXt_LOOP_ARY 4 /* for (@ary) {} */
1093#define CXt_LOOP_LAZYSV 5 /* for ('a'..'z') {} */
1094#define CXt_LOOP_LAZYIV 6 /* for (1..9) {} */
93661e56 1095#define CXt_LOOP_LIST 7 /* for (1,2,3) {} */
113ebcf5 1096#define CXt_LOOP_PLAIN 8 /* {} */
93661e56
DM
1097
1098#define CXt_SUB 9
1099#define CXt_FORMAT 10
1100#define CXt_EVAL 11
1101#define CXt_SUBST 12
76753e7f 1102/* SUBST doesn't feature in all switch statements. */
79072805 1103
ae423868 1104/* private flags for CXt_SUB and CXt_FORMAT */
79646418
DM
1105#define CXp_MULTICALL 0x10 /* part of a multicall (so don't tear down
1106 context on exit). (not CXt_FORMAT) */
1f27d788 1107#define CXp_HASARGS 0x20
b0065247
DM
1108#define CXp_SUB_RE 0x40 /* code called within regex, i.e. (?{}) */
1109#define CXp_SUB_RE_FAKE 0x80 /* fake sub CX for (?{}) in current scope */
ae423868 1110
6b35e009 1111/* private flags for CXt_EVAL */
1f27d788
NC
1112#define CXp_REAL 0x20 /* truly eval'', not a lookalike */
1113#define CXp_TRYBLOCK 0x40 /* eval{}, not eval'' or similar */
6b35e009 1114
7766f137 1115/* private flags for CXt_LOOP */
28e0cf42
DM
1116
1117/* this is only set in conjunction with CXp_FOR_GV */
1f27d788 1118#define CXp_FOR_DEF 0x10 /* foreach using $_ */
28e0cf42 1119/* these 3 are mutually exclusive */
d39c26a6 1120#define CXp_FOR_LVREF 0x20 /* foreach using \$var */
9af0df0b
DM
1121#define CXp_FOR_GV 0x40 /* foreach using package var */
1122#define CXp_FOR_PAD 0x80 /* foreach using lexical var */
28e0cf42 1123
9af0df0b 1124#define CxPADLOOP(c) ((c)->cx_type & CXp_FOR_PAD)
e846cb92 1125
1ed74d04
NC
1126/* private flags for CXt_SUBST */
1127#define CXp_ONCE 0x10 /* What was sbu_once in struct subst */
7766f137 1128
6b35e009 1129#define CxTYPE(c) ((c)->cx_type & CXTYPEMASK)
113ebcf5
DM
1130#define CxTYPE_is_LOOP(c) ( CxTYPE(cx) >= CXt_LOOP_ARY \
1131 && CxTYPE(cx) <= CXt_LOOP_PLAIN)
79646418 1132#define CxMULTICALL(c) ((c)->cx_type & CXp_MULTICALL)
0588a150 1133#define CxREALEVAL(c) (((c)->cx_type & (CXTYPEMASK|CXp_REAL)) \
7766f137 1134 == (CXt_EVAL|CXp_REAL))
0588a150 1135#define CxTRYBLOCK(c) (((c)->cx_type & (CXTYPEMASK|CXp_TRYBLOCK)) \
1d76a5c3 1136 == (CXt_EVAL|CXp_TRYBLOCK))
113ebcf5
DM
1137#define CxFOREACH(c) ( CxTYPE(cx) >= CXt_LOOP_ARY \
1138 && CxTYPE(cx) <= CXt_LOOP_LIST)
6b35e009 1139
109bf713 1140#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
79072805 1141
ccfc67b7
JH
1142/*
1143=head1 "Gimme" Values
1144*/
954c1994
GS
1145
1146/*
1147=for apidoc AmU||G_SCALAR
fbe13c60 1148Used to indicate scalar context. See C<L</GIMME_V>>, C<L</GIMME>>, and
954c1994
GS
1149L<perlcall>.
1150
1151=for apidoc AmU||G_ARRAY
fbe13c60 1152Used to indicate list context. See C<L</GIMME_V>>, C<L</GIMME>> and
954c1994
GS
1153L<perlcall>.
1154
1155=for apidoc AmU||G_VOID
fbe13c60 1156Used to indicate void context. See C<L</GIMME_V>> and L<perlcall>.
954c1994
GS
1157
1158=for apidoc AmU||G_DISCARD
1159Indicates that arguments returned from a callback should be discarded. See
1160L<perlcall>.
1161
1162=for apidoc AmU||G_EVAL
1163
1164Used to force a Perl C<eval> wrapper around a callback. See
1165L<perlcall>.
1166
1167=for apidoc AmU||G_NOARGS
1168
1169Indicates that no arguments are being sent to a callback. See
1170L<perlcall>.
1171
1172=cut
1173*/
1174
2f8edad0
NC
1175#define G_SCALAR 2
1176#define G_ARRAY 3
1177#define G_VOID 1
1178#define G_WANT 3
79072805 1179
864dbfa3 1180/* extra flags for Perl_call_* routines */
2f8edad0 1181#define G_DISCARD 4 /* Call FREETMPS.
b54b4831
NC
1182 Don't change this without consulting the
1183 hash actions codes defined in hv.h */
2f8edad0
NC
1184#define G_EVAL 8 /* Assume eval {} around subroutine call. */
1185#define G_NOARGS 16 /* Don't construct a @_ array. */
7ce09284 1186#define G_KEEPERR 32 /* Warn for errors, don't overwrite $@ */
2f8edad0
NC
1187#define G_NODEBUG 64 /* Disable debugging at toplevel. */
1188#define G_METHOD 128 /* Calling method. */
c40f1585 1189#define G_FAKINGEVAL 256 /* Faking an eval context for call_sv or
edb2152a 1190 fold_constants. */
67549bd2
NC
1191#define G_UNDEF_FILL 512 /* Fill the stack with &PL_sv_undef
1192 A special case for UNSHIFT in
1193 Perl_magic_methcall(). */
d1d7a15d
NC
1194#define G_WRITING_TO_STDERR 1024 /* Perl_write_to_stderr() is calling
1195 Perl_magic_methcall(). */
a1941760 1196#define G_RE_REPARSING 0x800 /* compiling a run-time /(?{..})/ */
c106c2be 1197#define G_METHOD_NAMED 4096 /* calling named method, eg without :: or ' */
e336de0d 1198
faef0170
HS
1199/* flag bits for PL_in_eval */
1200#define EVAL_NULL 0 /* not in an eval */
1201#define EVAL_INEVAL 1 /* some enclosing scope is an eval */
1202#define EVAL_WARNONLY 2 /* used by yywarn() when calling yyerror() */
864dbfa3 1203#define EVAL_KEEPERR 4 /* set by Perl_call_sv if G_KEEPERR */
6dc8a9e4 1204#define EVAL_INREQUIRE 8 /* The code is being required. */
a1941760 1205#define EVAL_RE_REPARSING 0x10 /* eval_sv() called with G_RE_REPARSING */
faef0170 1206
e336de0d
GS
1207/* Support for switching (stack and block) contexts.
1208 * This ensures magic doesn't invalidate local stack and cx pointers.
1209 */
1210
e788e7d3
GS
1211#define PERLSI_UNKNOWN -1
1212#define PERLSI_UNDEF 0
1213#define PERLSI_MAIN 1
1214#define PERLSI_MAGIC 2
1215#define PERLSI_SORT 3
1216#define PERLSI_SIGNAL 4
1217#define PERLSI_OVERLOAD 5
1218#define PERLSI_DESTROY 6
1219#define PERLSI_WARNHOOK 7
1220#define PERLSI_DIEHOOK 8
1221#define PERLSI_REQUIRE 9
e1a10f35 1222#define PERLSI_MULTICALL 10
e336de0d
GS
1223
1224struct stackinfo {
1225 AV * si_stack; /* stack for current runlevel */
1226 PERL_CONTEXT * si_cxstack; /* context stack for runlevel */
9bd87817
NC
1227 struct stackinfo * si_prev;
1228 struct stackinfo * si_next;
e336de0d
GS
1229 I32 si_cxix; /* current context index */
1230 I32 si_cxmax; /* maximum allocated index */
1231 I32 si_type; /* type of runlevel */
ce2f7c3b 1232 I32 si_markoff; /* offset where markstack begins for us.
e336de0d
GS
1233 * currently used only with DEBUGGING,
1234 * but not #ifdef-ed for bincompat */
1235};
1236
1237typedef struct stackinfo PERL_SI;
1238
3280af22
NIS
1239#define cxstack (PL_curstackinfo->si_cxstack)
1240#define cxstack_ix (PL_curstackinfo->si_cxix)
1241#define cxstack_max (PL_curstackinfo->si_cxmax)
e336de0d
GS
1242
1243#ifdef DEBUGGING
ce2f7c3b
GS
1244# define SET_MARK_OFFSET \
1245 PL_curstackinfo->si_markoff = PL_markstack_ptr - PL_markstack
e336de0d 1246#else
ce2f7c3b 1247# define SET_MARK_OFFSET NOOP
e336de0d
GS
1248#endif
1249
d3acc0f7 1250#define PUSHSTACKi(type) \
e336de0d 1251 STMT_START { \
3280af22 1252 PERL_SI *next = PL_curstackinfo->si_next; \
1c98cc53
DM
1253 DEBUG_l({ \
1254 int i = 0; PERL_SI *p = PL_curstackinfo; \
1255 while (p) { i++; p = p->si_prev; } \
1256 Perl_deb(aTHX_ "push STACKINFO %d at %s:%d\n", \
1257 i, __FILE__, __LINE__);}) \
e336de0d
GS
1258 if (!next) { \
1259 next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \
3280af22
NIS
1260 next->si_prev = PL_curstackinfo; \
1261 PL_curstackinfo->si_next = next; \
e336de0d
GS
1262 } \
1263 next->si_type = type; \
1264 next->si_cxix = -1; \
1265 AvFILLp(next->si_stack) = 0; \
3280af22
NIS
1266 SWITCHSTACK(PL_curstack,next->si_stack); \
1267 PL_curstackinfo = next; \
ce2f7c3b 1268 SET_MARK_OFFSET; \
e336de0d
GS
1269 } STMT_END
1270
e788e7d3 1271#define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)
d3acc0f7 1272
3095d977
GS
1273/* POPSTACK works with PL_stack_sp, so it may need to be bracketed by
1274 * PUTBACK/SPAGAIN to flush/refresh any local SP that may be active */
d3acc0f7 1275#define POPSTACK \
e336de0d 1276 STMT_START { \
39644a26 1277 dSP; \
c4420975 1278 PERL_SI * const prev = PL_curstackinfo->si_prev; \
1c98cc53
DM
1279 DEBUG_l({ \
1280 int i = -1; PERL_SI *p = PL_curstackinfo; \
1281 while (p) { i++; p = p->si_prev; } \
1282 Perl_deb(aTHX_ "pop STACKINFO %d at %s:%d\n", \
1283 i, __FILE__, __LINE__);}) \
e336de0d 1284 if (!prev) { \
3d04513d 1285 Perl_croak_popstack(); \
e336de0d 1286 } \
3280af22 1287 SWITCHSTACK(PL_curstack,prev->si_stack); \
e336de0d 1288 /* don't free prev here, free them all at the END{} */ \
3280af22 1289 PL_curstackinfo = prev; \
e336de0d
GS
1290 } STMT_END
1291
1292#define POPSTACK_TO(s) \
1293 STMT_START { \
3280af22 1294 while (PL_curstack != s) { \
bac4b2ad 1295 dounwind(-1); \
d3acc0f7 1296 POPSTACK; \
bac4b2ad 1297 } \
e336de0d 1298 } STMT_END
923e4eb5
JH
1299
1300#define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
1301#define IN_PERL_RUNTIME (PL_curcop != &PL_compiling)
1302
9850bf21
RH
1303/*
1304=head1 Multicall Functions
1305
1306=for apidoc Ams||dMULTICALL
72d33970 1307Declare local variables for a multicall. See L<perlcall/LIGHTWEIGHT CALLBACKS>.
9850bf21
RH
1308
1309=for apidoc Ams||PUSH_MULTICALL
1310Opening bracket for a lightweight callback.
0eda4409 1311See L<perlcall/LIGHTWEIGHT CALLBACKS>.
9850bf21
RH
1312
1313=for apidoc Ams||MULTICALL
72d33970 1314Make a lightweight callback. See L<perlcall/LIGHTWEIGHT CALLBACKS>.
9850bf21
RH
1315
1316=for apidoc Ams||POP_MULTICALL
1317Closing bracket for a lightweight callback.
0eda4409 1318See L<perlcall/LIGHTWEIGHT CALLBACKS>.
9850bf21
RH
1319
1320=cut
1321*/
1322
1323#define dMULTICALL \
b405d38b 1324 SV **newsp; /* set by CX_POPBLOCK */ \
9850bf21 1325 PERL_CONTEXT *cx; \
82f35e8b 1326 CV *multicall_cv; \
9850bf21
RH
1327 OP *multicall_cop; \
1328 bool multicall_oldcatch; \
d77cab04 1329 I32 saveix_floor; \
9850bf21
RH
1330 U8 hasargs = 0 /* used by PUSHSUB */
1331
82f35e8b 1332#define PUSH_MULTICALL(the_cv) \
b0065247 1333 PUSH_MULTICALL_FLAGS(the_cv, 0)
81ed78b2 1334
b0065247
DM
1335/* Like PUSH_MULTICALL, but allows you to specify extra flags
1336 * for the CX stack entry (this isn't part of the public API) */
81ed78b2 1337
b0065247 1338#define PUSH_MULTICALL_FLAGS(the_cv, flags) \
9850bf21 1339 STMT_START { \
0bcc34c2
AL
1340 CV * const _nOnclAshIngNamE_ = the_cv; \
1341 CV * const cv = _nOnclAshIngNamE_; \
b70d5558 1342 PADLIST * const padlist = CvPADLIST(cv); \
9850bf21 1343 multicall_oldcatch = CATCH_GET; \
9850bf21 1344 CATCH_SET(TRUE); \
e1a10f35 1345 PUSHSTACKi(PERLSI_MULTICALL); \
fd9b7244
DM
1346 PUSHBLOCK(cx, (CXt_SUB|CXp_MULTICALL|flags), gimme, \
1347 PL_stack_sp, PL_savestack_ix); \
ceb12bd8 1348 PUSHSUB(cx, cv, NULL, hasargs); \
49f582ca 1349 SAVEOP(); \
d77cab04 1350 saveix_floor = PL_savestack_ix; \
b0065247
DM
1351 if (!(flags & CXp_SUB_RE_FAKE)) \
1352 CvDEPTH(cv)++; \
d2af2719 1353 if (CvDEPTH(cv) >= 2) \
9850bf21 1354 Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \
9850bf21 1355 PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \
82f35e8b 1356 multicall_cv = cv; \
7e27c4a5 1357 PERL_UNUSED_VAR(multicall_cv); /* for API */ \
9850bf21
RH
1358 multicall_cop = CvSTART(cv); \
1359 } STMT_END
1360
1361#define MULTICALL \
1362 STMT_START { \
1363 PL_op = multicall_cop; \
1364 CALLRUNOPS(aTHX); \
d77cab04
DM
1365 cx = CX_CUR(); \
1366 LEAVE_SCOPE(saveix_floor); \
9850bf21
RH
1367 } STMT_END
1368
1369#define POP_MULTICALL \
1370 STMT_START { \
4ebe6e95 1371 cx = CX_CUR(); \
dfe0f39b 1372 CX_LEAVE_SCOPE(cx); \
b405d38b 1373 CX_POPSUB_COMMON(cx); \
4df352a8
DM
1374 newsp = PL_stack_base + cx->blk_oldsp; \
1375 gimme = cx->blk_gimme; \
7e27c4a5
DM
1376 PERL_UNUSED_VAR(newsp); /* for API */ \
1377 PERL_UNUSED_VAR(gimme); /* for API */ \
b405d38b 1378 CX_POPBLOCK(cx); \
5da525e9 1379 CX_POP(cx); \
1bbbfc50 1380 POPSTACK; \
9850bf21 1381 CATCH_SET(multicall_oldcatch); \
1bbbfc50 1382 SPAGAIN; \
9850bf21 1383 } STMT_END
b3ca2e83 1384
81ed78b2
DM
1385/* Change the CV of an already-pushed MULTICALL CxSUB block.
1386 * (this isn't part of the public API) */
1387
b0065247 1388#define CHANGE_MULTICALL_FLAGS(the_cv, flags) \
81ed78b2
DM
1389 STMT_START { \
1390 CV * const _nOnclAshIngNamE_ = the_cv; \
1391 CV * const cv = _nOnclAshIngNamE_; \
b70d5558 1392 PADLIST * const padlist = CvPADLIST(cv); \
4ebe6e95 1393 cx = CX_CUR(); \
79646418 1394 assert(CxMULTICALL(cx)); \
b405d38b 1395 CX_POPSUB_COMMON(cx); \
b0065247 1396 cx->cx_type = (CXt_SUB|CXp_MULTICALL|flags); \
ceb12bd8 1397 PUSHSUB(cx, cv, NULL, hasargs); \
b0065247
DM
1398 if (!(flags & CXp_SUB_RE_FAKE)) \
1399 CvDEPTH(cv)++; \
d2af2719 1400 if (CvDEPTH(cv) >= 2) \
81ed78b2 1401 Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \
81ed78b2
DM
1402 PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \
1403 multicall_cv = cv; \
1404 multicall_cop = CvSTART(cv); \
1405 } STMT_END
b3ca2e83 1406/*
14d04a33 1407 * ex: set ts=8 sts=4 sw=4 et:
b3ca2e83 1408 */