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