This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Increase $B::VERSION to 1.36
[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
11faa288 390 char * cop_stashpv; /* package line was compiled in */
57843af0 391 char * cop_file; /* file name the following line # is from */
6379d4a9 392 I32 cop_stashlen; /* negative for UTF8 */
57843af0 393#else
11faa288 394 HV * cop_stash; /* package line was compiled in */
79072805 395 GV * cop_filegv; /* file the following line # is from */
57843af0 396#endif
d5ec2987 397 U32 cop_hints; /* hints bits from pragmata */
a0d0e21e 398 U32 cop_seq; /* parse sequence number */
72dc9ed5
NC
399 /* Beware. mg.c and warnings.pl assume the type of this is STRLEN *: */
400 STRLEN * cop_warnings; /* lexical warnings bitmask */
b3ca2e83
NC
401 /* compile time state of %^H. See the comment in op.c for how this is
402 used to recreate a hash to return from caller. */
20439bc7 403 COPHH * cop_hints_hash;
79072805
LW
404};
405
57843af0
GS
406#ifdef USE_ITHREADS
407# define CopFILE(c) ((c)->cop_file)
408# define CopFILEGV(c) (CopFILE(c) \
a0714e2c 409 ? gv_fetchfile(CopFILE(c)) : NULL)
083fcd59 410
7e4e8c89
NC
411# ifdef NETWARE
412# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
d9095cec 413# define CopFILE_setn(c,pv,l) ((c)->cop_file = savepv((pv),(l)))
7e4e8c89
NC
414# else
415# define CopFILE_set(c,pv) ((c)->cop_file = savesharedpv(pv))
d9095cec 416# define CopFILE_setn(c,pv,l) ((c)->cop_file = savesharedpvn((pv),(l)))
7e4e8c89 417# endif
083fcd59 418
57843af0 419# define CopFILESV(c) (CopFILE(c) \
a0714e2c 420 ? GvSV(gv_fetchfile(CopFILE(c))) : NULL)
57843af0 421# define CopFILEAV(c) (CopFILE(c) \
7d49f689 422 ? GvAV(gv_fetchfile(CopFILE(c))) : NULL)
8688788e
SH
423# ifdef DEBUGGING
424# define CopFILEAVx(c) (assert(CopFILE(c)), \
36c7798d 425 GvAV(gv_fetchfile(CopFILE(c))))
8688788e
SH
426# else
427# define CopFILEAVx(c) (GvAV(gv_fetchfile(CopFILE(c))))
428# endif
57843af0 429# define CopSTASHPV(c) ((c)->cop_stashpv)
083fcd59 430
7e4e8c89 431# ifdef NETWARE
6379d4a9
FC
432# define CopSTASHPV_set(c,pv,n) ((c)->cop_stashpv = \
433 ((pv) ? savepvn(pv,n) : NULL))
7e4e8c89 434# else
6379d4a9
FC
435# define CopSTASHPV_set(c,pv,n) ((c)->cop_stashpv = (pv) \
436 ? savesharedpvn(pv,n) : NULL)
7e4e8c89 437# endif
083fcd59 438
6379d4a9
FC
439# define CopSTASH_len_set(c,n) ((c)->cop_stashlen = (n))
440# define CopSTASH_len(c) ((c)->cop_stashlen)
0eaf81c5
BF
441
442# define CopSTASH(c) (CopSTASHPV(c) \
6379d4a9
FC
443 ? gv_stashpvn(CopSTASHPV(c), \
444 CopSTASH_len(c) < 0 \
445 ? -CopSTASH_len(c) \
446 : CopSTASH_len(c), \
447 GV_ADD|SVf_UTF8*(CopSTASH_len(c) < 0) \
448 ) \
0eaf81c5 449 : NULL)
6379d4a9
FC
450# define CopSTASH_set(c,hv) (CopSTASHPV_set(c, \
451 (hv) ? HvNAME_get(hv) : NULL, \
452 (hv) ? HvNAMELEN(hv) : 0), \
453 CopSTASH_len_set(c, \
454 (hv) ? HvNAMEUTF8(hv) \
455 ? -HvNAMELEN(hv) \
456 : HvNAMELEN(hv) \
457 : 0))
ed221c57 458# define CopSTASH_eq(c,hv) ((hv) && stashpv_hvname_match(c,hv))
7e4e8c89
NC
459# ifdef NETWARE
460# define CopSTASH_free(c) SAVECOPSTASH_FREE(c)
7e4e8c89
NC
461# define CopFILE_free(c) SAVECOPFILE_FREE(c)
462# else
ed221c57 463# define CopSTASH_free(c) PerlMemShared_free(CopSTASHPV(c))
bd61b366 464# define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = NULL))
7e4e8c89 465# endif
57843af0
GS
466#else
467# define CopFILEGV(c) ((c)->cop_filegv)
f4dd75d9
GS
468# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
469# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
d9095cec 470# define CopFILE_setn(c,pv,l) CopFILEGV_set((c), gv_fetchfile_flags((pv),(l),0))
a0714e2c 471# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : NULL)
7d49f689 472# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : NULL)
8688788e
SH
473# ifdef DEBUGGING
474# define CopFILEAVx(c) (assert(CopFILEGV(c)), GvAV(CopFILEGV(c)))
475# else
476# define CopFILEAVx(c) (GvAV(CopFILEGV(c)))
477# endif
be46dfad
RGS
478# define CopFILE(c) (CopFILEGV(c) && GvSV(CopFILEGV(c)) \
479 ? SvPVX(GvSV(CopFILEGV(c))) : NULL)
57843af0 480# define CopSTASH(c) ((c)->cop_stash)
f4dd75d9 481# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
bd61b366 482# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : NULL)
f4dd75d9
GS
483 /* cop_stash is not refcounted */
484# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
485# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
05ec9bb3 486# define CopSTASH_free(c)
a0714e2c 487# define CopFILE_free(c) (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL))
05ec9bb3 488
57843af0 489#endif /* USE_ITHREADS */
20439bc7
Z
490
491#define CopHINTHASH_get(c) ((COPHH*)((c)->cop_hints_hash))
492#define CopHINTHASH_set(c,h) ((c)->cop_hints_hash = (h))
493
494/*
495=head1 COP Hint Reading
496*/
497
498/*
499=for apidoc Am|SV *|cop_hints_fetch_pvn|const COP *cop|const char *keypv|STRLEN keylen|U32 hash|U32 flags
500
501Look up the hint entry in the cop I<cop> with the key specified by
502I<keypv> and I<keylen>. If I<flags> has the C<COPHH_KEY_UTF8> bit set,
503the key octets are interpreted as UTF-8, otherwise they are interpreted
504as Latin-1. I<hash> is a precomputed hash of the key string, or zero if
505it has not been precomputed. Returns a mortal scalar copy of the value
506associated with the key, or C<&PL_sv_placeholder> if there is no value
507associated with the key.
508
509=cut
510*/
511
512#define cop_hints_fetch_pvn(cop, keypv, keylen, hash, flags) \
513 cophh_fetch_pvn(CopHINTHASH_get(cop), keypv, keylen, hash, flags)
514
515/*
516=for apidoc Am|SV *|cop_hints_fetch_pvs|const COP *cop|const char *key|U32 flags
517
518Like L</cop_hints_fetch_pvn>, but takes a literal string instead of a
519string/length pair, and no precomputed hash.
520
521=cut
522*/
523
524#define cop_hints_fetch_pvs(cop, key, flags) \
525 cophh_fetch_pvs(CopHINTHASH_get(cop), key, flags)
526
527/*
528=for apidoc Am|SV *|cop_hints_fetch_pv|const COP *cop|const char *key|U32 hash|U32 flags
529
530Like L</cop_hints_fetch_pvn>, but takes a nul-terminated string instead
531of a string/length pair.
532
533=cut
534*/
535
536#define cop_hints_fetch_pv(cop, key, hash, flags) \
537 cophh_fetch_pv(CopHINTHASH_get(cop), key, hash, flags)
538
539/*
540=for apidoc Am|SV *|cop_hints_fetch_sv|const COP *cop|SV *key|U32 hash|U32 flags
541
542Like L</cop_hints_fetch_pvn>, but takes a Perl scalar instead of a
543string/length pair.
544
545=cut
546*/
547
548#define cop_hints_fetch_sv(cop, key, hash, flags) \
549 cophh_fetch_sv(CopHINTHASH_get(cop), key, hash, flags)
550
551/*
552=for apidoc Am|HV *|cop_hints_2hv|const COP *cop|U32 flags
553
554Generates and returns a standard Perl hash representing the full set of
555hint entries in the cop I<cop>. I<flags> is currently unused and must
556be zero.
557
558=cut
559*/
560
561#define cop_hints_2hv(cop, flags) \
562 cophh_2hv(CopHINTHASH_get(cop), flags)
563
aebc0cbe 564#define CopLABEL(c) Perl_cop_fetch_label(aTHX_ (c), NULL, NULL)
5db1eb8d
BF
565#define CopLABEL_len(c,len) Perl_cop_fetch_label(aTHX_ (c), len, NULL)
566#define CopLABEL_len_flags(c,len,flags) Perl_cop_fetch_label(aTHX_ (c), len, flags)
dca6062a 567#define CopLABEL_alloc(pv) ((pv)?savepv(pv):NULL)
57843af0 568
ed094faf 569#define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv))
cc49e20b 570#define CopLINE(c) ((c)->cop_line)
57843af0
GS
571#define CopLINE_inc(c) (++CopLINE(c))
572#define CopLINE_dec(c) (--CopLINE(c))
573#define CopLINE_set(c,l) (CopLINE(c) = (l))
cc49e20b 574
248c2a4d 575/* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */
e37778c2 576#define OutCopFILE(c) CopFILE(c)
248c2a4d 577
623e6609 578/* FIXME NATIVE_HINTS if this is changed from op_private (see perl.h) */
d5ec2987 579#define CopHINTS_get(c) ((c)->cop_hints + 0)
623e6609 580#define CopHINTS_set(c, h) STMT_START { \
d5ec2987 581 (c)->cop_hints = (h); \
623e6609
NC
582 } STMT_END
583
79072805
LW
584/*
585 * Here we have some enormously heavy (or at least ponderous) wizardry.
586 */
587
588/* subroutine context */
589struct block_sub {
f9c764c5 590 OP * retop; /* op to execute on exit from sub */
8e663997
NC
591 /* Above here is the same for sub, format and eval. */
592 CV * cv;
f9c764c5 593 /* Above here is the same for sub and format. */
79072805
LW
594 AV * savearray;
595 AV * argarray;
bb172083 596 I32 olddepth;
f3548bdc 597 PAD *oldcomppad;
f9c764c5
NC
598};
599
600
601/* format context */
602struct block_format {
f39bc417 603 OP * retop; /* op to execute on exit from sub */
8e663997
NC
604 /* Above here is the same for sub, format and eval. */
605 CV * cv;
f9c764c5
NC
606 /* Above here is the same for sub and format. */
607 GV * gv;
608 GV * dfoutgv;
79072805
LW
609};
610
b36bdeca
DM
611/* base for the next two macros. Don't use directly.
612 * Note that the refcnt of the cv is incremented twice; The CX one is
613 * decremented by LEAVESUB, the other by LEAVE. */
614
ee98a1d6 615#define PUSHSUB_BASE(cx) \
5ac1e9b2 616 ENTRY_PROBE(GvENAME(CvGV(cv)), \
c6903450 617 CopFILE((const COP *)CvSTART(cv)), \
3e2413e5
DL
618 CopLINE((const COP *)CvSTART(cv)), \
619 CopSTASHPV((const COP *)CvSTART(cv))); \
5ac1e9b2 620 \
79072805 621 cx->blk_sub.cv = cv; \
b8f55b69 622 cx->blk_sub.olddepth = CvDEPTH(cv); \
ae423868 623 cx->cx_type |= (hasargs) ? CXp_HASARGS : 0; \
5f66b61c 624 cx->blk_sub.retop = NULL; \
b36bdeca 625 if (!CvDEPTH(cv)) { \
74c765eb
AL
626 SvREFCNT_inc_simple_void_NN(cv); \
627 SvREFCNT_inc_simple_void_NN(cv); \
b36bdeca
DM
628 SAVEFREESV(cv); \
629 }
630
ee98a1d6
DM
631
632#define PUSHSUB(cx) \
777d9014
FC
633 { \
634 /* If the context is indeterminate, then only the lvalue */ \
635 /* flags that the caller also has are applicable. */ \
636 U8 phlags = \
637 (PL_op->op_flags & OPf_WANT) \
638 ? OPpENTERSUB_LVAL_MASK \
639 : !(PL_op->op_private & OPpENTERSUB_LVAL_MASK) \
eebd3bc0 640 ? 0 : Perl_was_lvalue_sub(aTHX); \
ee98a1d6 641 PUSHSUB_BASE(cx) \
446d0787 642 cx->blk_u16 = PL_op->op_private & \
0e9700df 643 (phlags|OPpDEREF); \
777d9014 644 }
79072805 645
ee98a1d6
DM
646/* variant for use by OP_DBSTATE, where op_private holds hint bits */
647#define PUSHSUB_DB(cx) \
648 PUSHSUB_BASE(cx) \
446d0787 649 cx->blk_u16 = 0;
ee98a1d6
DM
650
651
10067d9a 652#define PUSHFORMAT(cx, retop) \
f9c764c5
NC
653 cx->blk_format.cv = cv; \
654 cx->blk_format.gv = gv; \
655 cx->blk_format.retop = (retop); \
f9c764c5
NC
656 cx->blk_format.dfoutgv = PL_defoutgv; \
657 SvREFCNT_inc_void(cx->blk_format.dfoutgv)
79072805 658
3db8f154 659#define POP_SAVEARRAY() \
6d4ff0d2 660 STMT_START { \
3280af22 661 SvREFCNT_dec(GvAV(PL_defgv)); \
a8bba7fa 662 GvAV(PL_defgv) = cx->blk_sub.savearray; \
6d4ff0d2 663 } STMT_END
6d4ff0d2 664
ecf8e9dd 665/* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't
8e09340b
GS
666 * leave any (a fast av_clear(ary), basically) */
667#define CLEAR_ARGARRAY(ary) \
668 STMT_START { \
669 AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary); \
9c6bc640 670 AvARRAY(ary) = AvALLOC(ary); \
8e09340b
GS
671 AvFILLp(ary) = -1; \
672 } STMT_END
7766f137 673
b0d9ce38
GS
674#define POPSUB(cx,sv) \
675 STMT_START { \
8f629a87
NC
676 RETURN_PROBE(GvENAME(CvGV((const CV*)cx->blk_sub.cv)), \
677 CopFILE((COP*)CvSTART((const CV*)cx->blk_sub.cv)), \
3e2413e5
DL
678 CopLINE((COP*)CvSTART((const CV*)cx->blk_sub.cv)), \
679 CopSTASHPV((COP*)CvSTART((const CV*)cx->blk_sub.cv))); \
5ac1e9b2 680 \
bafb2adc 681 if (CxHASARGS(cx)) { \
7766f137 682 POP_SAVEARRAY(); \
d8b46c1b 683 /* abandon @_ if it got reified */ \
a8bba7fa 684 if (AvREAL(cx->blk_sub.argarray)) { \
e2d306cb 685 const SSize_t fill = AvFILLp(cx->blk_sub.argarray); \
a8bba7fa
GS
686 SvREFCNT_dec(cx->blk_sub.argarray); \
687 cx->blk_sub.argarray = newAV(); \
688 av_extend(cx->blk_sub.argarray, fill); \
11ca45c0 689 AvREIFY_only(cx->blk_sub.argarray); \
b1bc3f34 690 CX_CURPAD_SV(cx->blk_sub, 0) = MUTABLE_SV(cx->blk_sub.argarray); \
d8b46c1b 691 } \
7766f137 692 else { \
8e09340b 693 CLEAR_ARGARRAY(cx->blk_sub.argarray); \
7766f137 694 } \
79072805 695 } \
b1bc3f34 696 sv = MUTABLE_SV(cx->blk_sub.cv); \
8f629a87 697 if (sv && (CvDEPTH((const CV*)sv) = cx->blk_sub.olddepth)) \
a0714e2c 698 sv = NULL; \
b0d9ce38
GS
699 } STMT_END
700
701#define LEAVESUB(sv) \
702 STMT_START { \
703 if (sv) \
704 SvREFCNT_dec(sv); \
705 } STMT_END
79072805
LW
706
707#define POPFORMAT(cx) \
f9c764c5
NC
708 setdefout(cx->blk_format.dfoutgv); \
709 SvREFCNT_dec(cx->blk_format.dfoutgv);
79072805
LW
710
711/* eval context */
712struct block_eval {
8e663997
NC
713 OP * retop; /* op to execute on exit from eval */
714 /* Above here is the same for sub, format and eval. */
0f79a09d 715 SV * old_namesv;
79072805 716 OP * old_eval_root;
748a9306 717 SV * cur_text;
2090ab20 718 CV * cv;
abd70938 719 JMPENV * cur_top_env; /* value of PL_top_env when eval CX created */
79072805
LW
720};
721
17347a51
NC
722/* If we ever need more than 512 op types, change the shift from 7.
723 blku_gimme is actually also only 2 bits, so could be merged with something.
724*/
725
726#define CxOLD_IN_EVAL(cx) (((cx)->blk_u16) & 0x7F)
727#define CxOLD_OP_TYPE(cx) (((cx)->blk_u16) >> 7)
85a64632 728
6b75f042 729#define PUSHEVAL(cx,n) \
0f79a09d 730 STMT_START { \
17347a51
NC
731 assert(!(PL_in_eval & ~0x7F)); \
732 assert(!(PL_op->op_type & ~0x1FF)); \
733 cx->blk_u16 = (PL_in_eval & 0x7F) | ((U16)PL_op->op_type << 7); \
a0714e2c 734 cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : NULL); \
a8bba7fa 735 cx->blk_eval.old_eval_root = PL_eval_root; \
bdc0bf6f 736 cx->blk_eval.cur_text = PL_parser ? PL_parser->linestr : NULL; \
601f1833 737 cx->blk_eval.cv = NULL; /* set by doeval(), as applicable */ \
5f66b61c 738 cx->blk_eval.retop = NULL; \
abd70938 739 cx->blk_eval.cur_top_env = PL_top_env; \
0f79a09d 740 } STMT_END
79072805
LW
741
742#define POPEVAL(cx) \
0f79a09d 743 STMT_START { \
85a64632
NC
744 PL_in_eval = CxOLD_IN_EVAL(cx); \
745 optype = CxOLD_OP_TYPE(cx); \
7766f137 746 PL_eval_root = cx->blk_eval.old_eval_root; \
0f79a09d
GS
747 if (cx->blk_eval.old_namesv) \
748 sv_2mortal(cx->blk_eval.old_namesv); \
749 } STMT_END
79072805
LW
750
751/* loop context */
752struct block_loop {
79072805 753 I32 resetsp;
022eaa24 754 LOOP * my_op; /* My op, that contains redo, next and last ops. */
df530c37
DM
755 union { /* different ways of locating the iteration variable */
756 SV **svp;
757 GV *gv;
758 PAD *oldcomppad; /* only used in ITHREADS */
759 } itervar_u;
493b0a3c 760 union {
d01136d6
BS
761 struct { /* valid if type is LOOP_FOR or LOOP_PLAIN (but {NULL,0})*/
762 AV * ary; /* use the stack if this is NULL */
763 IV ix;
764 } ary;
765 struct { /* valid if type is LOOP_LAZYIV */
766 IV cur;
767 IV end;
768 } lazyiv;
769 struct { /* valid if type if LOOP_LAZYSV */
770 SV * cur;
771 SV * end; /* maxiumum value (or minimum in reverse) */
772 } lazysv;
773 } state_u;
79072805
LW
774};
775
7766f137 776#ifdef USE_ITHREADS
f83b46a0
DM
777# define CxITERVAR_PADSV(c) \
778 &CX_CURPAD_SV( (c)->blk_loop.itervar_u, (c)->blk_loop.my_op->op_targ)
779#else
780# define CxITERVAR_PADSV(c) ((c)->blk_loop.itervar_u.svp)
781#endif
782
783#define CxITERVAR(c) \
df530c37 784 ((c)->blk_loop.itervar_u.oldcomppad \
e846cb92 785 ? (CxPADLOOP(c) \
f83b46a0 786 ? CxITERVAR_PADSV(c) \
df530c37 787 : &GvSV((c)->blk_loop.itervar_u.gv)) \
7766f137 788 : (SV**)NULL)
f83b46a0 789
b1cf8b36 790#define CxLABEL(c) (0 + CopLABEL((c)->blk_oldcop))
5db1eb8d
BF
791#define CxLABEL_len(c,len) (0 + CopLABEL_len((c)->blk_oldcop, len))
792#define CxLABEL_len_flags(c,len,flags) (0 + CopLABEL_len_flags((c)->blk_oldcop, len, flags))
ae423868 793#define CxHASARGS(c) (((c)->cx_type & CXp_HASARGS) == CXp_HASARGS)
446d0787 794#define CxLVAL(c) (0 + (c)->blk_u16)
7766f137 795
3b719c58
NC
796#define PUSHLOOP_PLAIN(cx, s) \
797 cx->blk_loop.resetsp = s - PL_stack_base; \
798 cx->blk_loop.my_op = cLOOP; \
d01136d6
BS
799 cx->blk_loop.state_u.ary.ary = NULL; \
800 cx->blk_loop.state_u.ary.ix = 0; \
df530c37 801 cx->blk_loop.itervar_u.svp = NULL;
3b719c58 802
df530c37 803#define PUSHLOOP_FOR(cx, ivar, s) \
38a230cb 804 cx->blk_loop.resetsp = s - PL_stack_base; \
022eaa24 805 cx->blk_loop.my_op = cLOOP; \
d01136d6
BS
806 cx->blk_loop.state_u.ary.ary = NULL; \
807 cx->blk_loop.state_u.ary.ix = 0; \
df530c37 808 cx->blk_loop.itervar_u.svp = (SV**)(ivar);
79072805
LW
809
810#define POPLOOP(cx) \
d01136d6
BS
811 if (CxTYPE(cx) == CXt_LOOP_LAZYSV) { \
812 SvREFCNT_dec(cx->blk_loop.state_u.lazysv.cur); \
813 SvREFCNT_dec(cx->blk_loop.state_u.lazysv.end); \
814 } \
d01136d6
BS
815 if (CxTYPE(cx) == CXt_LOOP_FOR) \
816 SvREFCNT_dec(cx->blk_loop.state_u.ary.ary);
79072805 817
0d863452
RH
818/* given/when context */
819struct block_givwhen {
820 OP *leave_op;
821};
822
823#define PUSHGIVEN(cx) \
824 cx->blk_givwhen.leave_op = cLOGOP->op_other;
825
826#define PUSHWHEN PUSHGIVEN
827
79072805
LW
828/* context common to subroutines, evals and loops */
829struct block {
446d0787 830 U8 blku_type; /* what kind of context this is */
2e0df0e8 831 U8 blku_gimme; /* is this block running in list context? */
17347a51 832 U16 blku_u16; /* used by block_sub and block_eval (so far) */
79072805
LW
833 I32 blku_oldsp; /* stack pointer to copy stuff down to */
834 COP * blku_oldcop; /* old curcop pointer */
79072805
LW
835 I32 blku_oldmarksp; /* mark stack index */
836 I32 blku_oldscopesp; /* scope stack index */
837 PMOP * blku_oldpm; /* values of pattern match vars */
79072805
LW
838
839 union {
840 struct block_sub blku_sub;
f9c764c5 841 struct block_format blku_format;
79072805
LW
842 struct block_eval blku_eval;
843 struct block_loop blku_loop;
0d863452 844 struct block_givwhen blku_givwhen;
79072805
LW
845 } blk_u;
846};
847#define blk_oldsp cx_u.cx_blk.blku_oldsp
848#define blk_oldcop cx_u.cx_blk.blku_oldcop
79072805
LW
849#define blk_oldmarksp cx_u.cx_blk.blku_oldmarksp
850#define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp
851#define blk_oldpm cx_u.cx_blk.blku_oldpm
852#define blk_gimme cx_u.cx_blk.blku_gimme
446d0787 853#define blk_u16 cx_u.cx_blk.blku_u16
79072805 854#define blk_sub cx_u.cx_blk.blk_u.blku_sub
f9c764c5 855#define blk_format cx_u.cx_blk.blk_u.blku_format
79072805
LW
856#define blk_eval cx_u.cx_blk.blk_u.blku_eval
857#define blk_loop cx_u.cx_blk.blk_u.blku_loop
0d863452 858#define blk_givwhen cx_u.cx_blk.blk_u.blku_givwhen
79072805 859
1c98cc53 860#define DEBUG_CX(action) \
d9f81b50 861 DEBUG_l( \
1c98cc53
DM
862 Perl_deb(aTHX_ "CX %ld %s %s (scope %ld,%ld) at %s:%d\n", \
863 (long)cxstack_ix, \
864 action, \
865 PL_block_type[CxTYPE(&cxstack[cxstack_ix])], \
866 (long)PL_scopestack_ix, \
867 (long)(cxstack[cxstack_ix].blk_oldscopesp), \
d9f81b50 868 __FILE__, __LINE__));
1c98cc53 869
79072805 870/* Enter a block. */
8990e307 871#define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \
79072805 872 cx->cx_type = t, \
3280af22
NIS
873 cx->blk_oldsp = sp - PL_stack_base, \
874 cx->blk_oldcop = PL_curcop, \
1aff0e91 875 cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \
3280af22 876 cx->blk_oldscopesp = PL_scopestack_ix, \
3280af22 877 cx->blk_oldpm = PL_curpm, \
eb160463 878 cx->blk_gimme = (U8)gimme; \
1c98cc53 879 DEBUG_CX("PUSH");
79072805
LW
880
881/* Exit a block (RETURN and LAST). */
1c98cc53
DM
882#define POPBLOCK(cx,pm) \
883 DEBUG_CX("POP"); \
884 cx = &cxstack[cxstack_ix--], \
1aff0e91 885 newsp = PL_stack_base + cx->blk_oldsp, \
3280af22
NIS
886 PL_curcop = cx->blk_oldcop, \
887 PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
888 PL_scopestack_ix = cx->blk_oldscopesp, \
3280af22 889 pm = cx->blk_oldpm, \
1c98cc53 890 gimme = cx->blk_gimme;
79072805
LW
891
892/* Continue a block elsewhere (NEXT and REDO). */
1c98cc53
DM
893#define TOPBLOCK(cx) \
894 DEBUG_CX("TOP"); \
895 cx = &cxstack[cxstack_ix], \
1aff0e91 896 PL_stack_sp = PL_stack_base + cx->blk_oldsp, \
3280af22
NIS
897 PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
898 PL_scopestack_ix = cx->blk_oldscopesp, \
1c98cc53 899 PL_curpm = cx->blk_oldpm;
79072805
LW
900
901/* substitution context */
902struct subst {
446d0787 903 U8 sbu_type; /* what kind of context this is */
1ed74d04 904 U8 sbu_rflags;
446d0787 905 U16 sbu_rxtainted; /* matches struct block */
79072805
LW
906 I32 sbu_iters;
907 I32 sbu_maxiters;
4633a7c4 908 I32 sbu_oldsave;
79072805
LW
909 char * sbu_orig;
910 SV * sbu_dstr;
911 SV * sbu_targ;
912 char * sbu_s;
913 char * sbu_m;
914 char * sbu_strend;
c90c0ff4 915 void * sbu_rxres;
c07a80fd 916 REGEXP * sbu_rx;
79072805
LW
917};
918#define sb_iters cx_u.cx_subst.sbu_iters
919#define sb_maxiters cx_u.cx_subst.sbu_maxiters
22e551b9 920#define sb_rflags cx_u.cx_subst.sbu_rflags
4633a7c4 921#define sb_oldsave cx_u.cx_subst.sbu_oldsave
71be2cbc 922#define sb_rxtainted cx_u.cx_subst.sbu_rxtainted
79072805
LW
923#define sb_orig cx_u.cx_subst.sbu_orig
924#define sb_dstr cx_u.cx_subst.sbu_dstr
925#define sb_targ cx_u.cx_subst.sbu_targ
926#define sb_s cx_u.cx_subst.sbu_s
927#define sb_m cx_u.cx_subst.sbu_m
928#define sb_strend cx_u.cx_subst.sbu_strend
c90c0ff4 929#define sb_rxres cx_u.cx_subst.sbu_rxres
c07a80fd 930#define sb_rx cx_u.cx_subst.sbu_rx
79072805 931
9c105995
NC
932#ifdef PERL_CORE
933# define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \
79072805
LW
934 cx->sb_iters = iters, \
935 cx->sb_maxiters = maxiters, \
22e551b9 936 cx->sb_rflags = r_flags, \
4633a7c4 937 cx->sb_oldsave = oldsave, \
71be2cbc 938 cx->sb_rxtainted = rxtainted, \
79072805
LW
939 cx->sb_orig = orig, \
940 cx->sb_dstr = dstr, \
941 cx->sb_targ = targ, \
942 cx->sb_s = s, \
943 cx->sb_m = m, \
944 cx->sb_strend = strend, \
4608196e 945 cx->sb_rxres = NULL, \
c07a80fd 946 cx->sb_rx = rx, \
1ed74d04 947 cx->cx_type = CXt_SUBST | (once ? CXp_ONCE : 0); \
e22ae1e2 948 rxres_save(&cx->sb_rxres, rx); \
b69b0499 949 (void)ReREFCNT_inc(rx)
79072805 950
9c105995 951# define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \
e22ae1e2
DM
952 rxres_free(&cx->sb_rxres); \
953 ReREFCNT_dec(cx->sb_rx)
9c105995
NC
954#endif
955
956#define CxONCE(cx) ((cx)->cx_type & CXp_ONCE)
79072805
LW
957
958struct context {
79072805
LW
959 union {
960 struct block cx_blk;
961 struct subst cx_subst;
962 } cx_u;
963};
2e0df0e8 964#define cx_type cx_u.cx_subst.sbu_type
6b35e009 965
76753e7f
NC
966/* If you re-order these, there is also an array of uppercase names in perl.h
967 and a static array of context names in pp_ctl.c */
3701055e 968#define CXTYPEMASK 0xf
79072805 969#define CXt_NULL 0
76753e7f
NC
970#define CXt_WHEN 1
971#define CXt_BLOCK 2
972/* When micro-optimising :-) keep GIVEN next to the LOOPs, as these 5 share a
973 jump table in pp_ctl.c
974 The first 4 don't have a 'case' in at least one switch statement in pp_ctl.c
975*/
976#define CXt_GIVEN 3
c6fdafd0 977/* This is first so that CXt_LOOP_FOR|CXt_LOOP_LAZYIV is CXt_LOOP_LAZYIV */
76753e7f
NC
978#define CXt_LOOP_FOR 4
979#define CXt_LOOP_PLAIN 5
980#define CXt_LOOP_LAZYSV 6
981#define CXt_LOOP_LAZYIV 7
982#define CXt_SUB 8
983#define CXt_FORMAT 9
984#define CXt_EVAL 10
985#define CXt_SUBST 11
986/* SUBST doesn't feature in all switch statements. */
79072805 987
3701055e
NC
988/* private flags for CXt_SUB and CXt_NULL
989 However, this is checked in many places which do not check the type, so
990 this bit needs to be kept clear for most everything else. For reasons I
991 haven't investigated, it can coexist with CXp_FOR_DEF */
1f27d788
NC
992#define CXp_MULTICALL 0x10 /* part of a multicall (so don't
993 tear down context on exit). */
9850bf21 994
ae423868 995/* private flags for CXt_SUB and CXt_FORMAT */
1f27d788 996#define CXp_HASARGS 0x20
ae423868 997
6b35e009 998/* private flags for CXt_EVAL */
1f27d788
NC
999#define CXp_REAL 0x20 /* truly eval'', not a lookalike */
1000#define CXp_TRYBLOCK 0x40 /* eval{}, not eval'' or similar */
6b35e009 1001
7766f137 1002/* private flags for CXt_LOOP */
1f27d788 1003#define CXp_FOR_DEF 0x10 /* foreach using $_ */
56b98d0f 1004#define CxPADLOOP(c) ((c)->blk_loop.my_op->op_targ)
e846cb92 1005
1ed74d04
NC
1006/* private flags for CXt_SUBST */
1007#define CXp_ONCE 0x10 /* What was sbu_once in struct subst */
7766f137 1008
6b35e009 1009#define CxTYPE(c) ((c)->cx_type & CXTYPEMASK)
76753e7f 1010#define CxTYPE_is_LOOP(c) (((c)->cx_type & 0xC) == 0x4)
9850bf21
RH
1011#define CxMULTICALL(c) (((c)->cx_type & CXp_MULTICALL) \
1012 == CXp_MULTICALL)
0588a150 1013#define CxREALEVAL(c) (((c)->cx_type & (CXTYPEMASK|CXp_REAL)) \
7766f137 1014 == (CXt_EVAL|CXp_REAL))
0588a150 1015#define CxTRYBLOCK(c) (((c)->cx_type & (CXTYPEMASK|CXp_TRYBLOCK)) \
1d76a5c3 1016 == (CXt_EVAL|CXp_TRYBLOCK))
3b719c58
NC
1017#define CxFOREACH(c) (CxTYPE_is_LOOP(c) && CxTYPE(c) != CXt_LOOP_PLAIN)
1018#define CxFOREACHDEF(c) ((CxTYPE_is_LOOP(c) && CxTYPE(c) != CXt_LOOP_PLAIN) \
1019 && ((c)->cx_type & CXp_FOR_DEF))
6b35e009 1020
109bf713 1021#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
79072805 1022
ccfc67b7
JH
1023/*
1024=head1 "Gimme" Values
1025*/
954c1994
GS
1026
1027/*
1028=for apidoc AmU||G_SCALAR
1029Used to indicate scalar context. See C<GIMME_V>, C<GIMME>, and
1030L<perlcall>.
1031
1032=for apidoc AmU||G_ARRAY
91e74348 1033Used to indicate list context. See C<GIMME_V>, C<GIMME> and
954c1994
GS
1034L<perlcall>.
1035
1036=for apidoc AmU||G_VOID
1037Used to indicate void context. See C<GIMME_V> and L<perlcall>.
1038
1039=for apidoc AmU||G_DISCARD
1040Indicates that arguments returned from a callback should be discarded. See
1041L<perlcall>.
1042
1043=for apidoc AmU||G_EVAL
1044
1045Used to force a Perl C<eval> wrapper around a callback. See
1046L<perlcall>.
1047
1048=for apidoc AmU||G_NOARGS
1049
1050Indicates that no arguments are being sent to a callback. See
1051L<perlcall>.
1052
1053=cut
1054*/
1055
2f8edad0
NC
1056#define G_SCALAR 2
1057#define G_ARRAY 3
1058#define G_VOID 1
1059#define G_WANT 3
79072805 1060
864dbfa3 1061/* extra flags for Perl_call_* routines */
2f8edad0 1062#define G_DISCARD 4 /* Call FREETMPS.
b54b4831
NC
1063 Don't change this without consulting the
1064 hash actions codes defined in hv.h */
2f8edad0
NC
1065#define G_EVAL 8 /* Assume eval {} around subroutine call. */
1066#define G_NOARGS 16 /* Don't construct a @_ array. */
7ce09284 1067#define G_KEEPERR 32 /* Warn for errors, don't overwrite $@ */
2f8edad0
NC
1068#define G_NODEBUG 64 /* Disable debugging at toplevel. */
1069#define G_METHOD 128 /* Calling method. */
c40f1585 1070#define G_FAKINGEVAL 256 /* Faking an eval context for call_sv or
edb2152a 1071 fold_constants. */
67549bd2
NC
1072#define G_UNDEF_FILL 512 /* Fill the stack with &PL_sv_undef
1073 A special case for UNSHIFT in
1074 Perl_magic_methcall(). */
d1d7a15d
NC
1075#define G_WRITING_TO_STDERR 1024 /* Perl_write_to_stderr() is calling
1076 Perl_magic_methcall(). */
e336de0d 1077
faef0170
HS
1078/* flag bits for PL_in_eval */
1079#define EVAL_NULL 0 /* not in an eval */
1080#define EVAL_INEVAL 1 /* some enclosing scope is an eval */
1081#define EVAL_WARNONLY 2 /* used by yywarn() when calling yyerror() */
864dbfa3 1082#define EVAL_KEEPERR 4 /* set by Perl_call_sv if G_KEEPERR */
6dc8a9e4 1083#define EVAL_INREQUIRE 8 /* The code is being required. */
faef0170 1084
e336de0d
GS
1085/* Support for switching (stack and block) contexts.
1086 * This ensures magic doesn't invalidate local stack and cx pointers.
1087 */
1088
e788e7d3
GS
1089#define PERLSI_UNKNOWN -1
1090#define PERLSI_UNDEF 0
1091#define PERLSI_MAIN 1
1092#define PERLSI_MAGIC 2
1093#define PERLSI_SORT 3
1094#define PERLSI_SIGNAL 4
1095#define PERLSI_OVERLOAD 5
1096#define PERLSI_DESTROY 6
1097#define PERLSI_WARNHOOK 7
1098#define PERLSI_DIEHOOK 8
1099#define PERLSI_REQUIRE 9
e336de0d
GS
1100
1101struct stackinfo {
1102 AV * si_stack; /* stack for current runlevel */
1103 PERL_CONTEXT * si_cxstack; /* context stack for runlevel */
9bd87817
NC
1104 struct stackinfo * si_prev;
1105 struct stackinfo * si_next;
e336de0d
GS
1106 I32 si_cxix; /* current context index */
1107 I32 si_cxmax; /* maximum allocated index */
1108 I32 si_type; /* type of runlevel */
ce2f7c3b 1109 I32 si_markoff; /* offset where markstack begins for us.
e336de0d
GS
1110 * currently used only with DEBUGGING,
1111 * but not #ifdef-ed for bincompat */
1112};
1113
1114typedef struct stackinfo PERL_SI;
1115
3280af22
NIS
1116#define cxstack (PL_curstackinfo->si_cxstack)
1117#define cxstack_ix (PL_curstackinfo->si_cxix)
1118#define cxstack_max (PL_curstackinfo->si_cxmax)
e336de0d
GS
1119
1120#ifdef DEBUGGING
ce2f7c3b
GS
1121# define SET_MARK_OFFSET \
1122 PL_curstackinfo->si_markoff = PL_markstack_ptr - PL_markstack
e336de0d 1123#else
ce2f7c3b 1124# define SET_MARK_OFFSET NOOP
e336de0d
GS
1125#endif
1126
d3acc0f7 1127#define PUSHSTACKi(type) \
e336de0d 1128 STMT_START { \
3280af22 1129 PERL_SI *next = PL_curstackinfo->si_next; \
1c98cc53
DM
1130 DEBUG_l({ \
1131 int i = 0; PERL_SI *p = PL_curstackinfo; \
1132 while (p) { i++; p = p->si_prev; } \
1133 Perl_deb(aTHX_ "push STACKINFO %d at %s:%d\n", \
1134 i, __FILE__, __LINE__);}) \
e336de0d
GS
1135 if (!next) { \
1136 next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \
3280af22
NIS
1137 next->si_prev = PL_curstackinfo; \
1138 PL_curstackinfo->si_next = next; \
e336de0d
GS
1139 } \
1140 next->si_type = type; \
1141 next->si_cxix = -1; \
1142 AvFILLp(next->si_stack) = 0; \
3280af22
NIS
1143 SWITCHSTACK(PL_curstack,next->si_stack); \
1144 PL_curstackinfo = next; \
ce2f7c3b 1145 SET_MARK_OFFSET; \
e336de0d
GS
1146 } STMT_END
1147
e788e7d3 1148#define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)
d3acc0f7 1149
3095d977
GS
1150/* POPSTACK works with PL_stack_sp, so it may need to be bracketed by
1151 * PUTBACK/SPAGAIN to flush/refresh any local SP that may be active */
d3acc0f7 1152#define POPSTACK \
e336de0d 1153 STMT_START { \
39644a26 1154 dSP; \
c4420975 1155 PERL_SI * const prev = PL_curstackinfo->si_prev; \
1c98cc53
DM
1156 DEBUG_l({ \
1157 int i = -1; PERL_SI *p = PL_curstackinfo; \
1158 while (p) { i++; p = p->si_prev; } \
1159 Perl_deb(aTHX_ "pop STACKINFO %d at %s:%d\n", \
1160 i, __FILE__, __LINE__);}) \
e336de0d 1161 if (!prev) { \
bf49b057 1162 PerlIO_printf(Perl_error_log, "panic: POPSTACK\n"); \
e336de0d
GS
1163 my_exit(1); \
1164 } \
3280af22 1165 SWITCHSTACK(PL_curstack,prev->si_stack); \
e336de0d 1166 /* don't free prev here, free them all at the END{} */ \
3280af22 1167 PL_curstackinfo = prev; \
e336de0d
GS
1168 } STMT_END
1169
1170#define POPSTACK_TO(s) \
1171 STMT_START { \
3280af22 1172 while (PL_curstack != s) { \
bac4b2ad 1173 dounwind(-1); \
d3acc0f7 1174 POPSTACK; \
bac4b2ad 1175 } \
e336de0d 1176 } STMT_END
923e4eb5
JH
1177
1178#define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
1179#define IN_PERL_RUNTIME (PL_curcop != &PL_compiling)
1180
9850bf21
RH
1181/*
1182=head1 Multicall Functions
1183
1184=for apidoc Ams||dMULTICALL
0eda4409 1185Declare local variables for a multicall. See L<perlcall/LIGHTWEIGHT CALLBACKS>.
9850bf21
RH
1186
1187=for apidoc Ams||PUSH_MULTICALL
1188Opening bracket for a lightweight callback.
0eda4409 1189See L<perlcall/LIGHTWEIGHT CALLBACKS>.
9850bf21
RH
1190
1191=for apidoc Ams||MULTICALL
0eda4409 1192Make a lightweight callback. See L<perlcall/LIGHTWEIGHT CALLBACKS>.
9850bf21
RH
1193
1194=for apidoc Ams||POP_MULTICALL
1195Closing bracket for a lightweight callback.
0eda4409 1196See L<perlcall/LIGHTWEIGHT CALLBACKS>.
9850bf21
RH
1197
1198=cut
1199*/
1200
1201#define dMULTICALL \
1202 SV **newsp; /* set by POPBLOCK */ \
1203 PERL_CONTEXT *cx; \
82f35e8b 1204 CV *multicall_cv; \
9850bf21
RH
1205 OP *multicall_cop; \
1206 bool multicall_oldcatch; \
1207 U8 hasargs = 0 /* used by PUSHSUB */
1208
82f35e8b 1209#define PUSH_MULTICALL(the_cv) \
9850bf21 1210 STMT_START { \
0bcc34c2
AL
1211 CV * const _nOnclAshIngNamE_ = the_cv; \
1212 CV * const cv = _nOnclAshIngNamE_; \
1213 AV * const padlist = CvPADLIST(cv); \
9850bf21
RH
1214 ENTER; \
1215 multicall_oldcatch = CATCH_GET; \
1216 SAVETMPS; SAVEVPTR(PL_op); \
1217 CATCH_SET(TRUE); \
1bbbfc50 1218 PUSHSTACKi(PERLSI_SORT); \
9850bf21
RH
1219 PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp); \
1220 PUSHSUB(cx); \
1221 if (++CvDEPTH(cv) >= 2) { \
1222 PERL_STACK_OVERFLOW_CHECK(); \
1223 Perl_pad_push(aTHX_ padlist, CvDEPTH(cv)); \
1224 } \
1225 SAVECOMPPAD(); \
1226 PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); \
82f35e8b 1227 multicall_cv = cv; \
9850bf21
RH
1228 multicall_cop = CvSTART(cv); \
1229 } STMT_END
1230
1231#define MULTICALL \
1232 STMT_START { \
1233 PL_op = multicall_cop; \
1234 CALLRUNOPS(aTHX); \
1235 } STMT_END
1236
1237#define POP_MULTICALL \
1238 STMT_START { \
f837477c
DM
1239 if (! --CvDEPTH(multicall_cv)) \
1240 LEAVESUB(multicall_cv); \
9850bf21 1241 POPBLOCK(cx,PL_curpm); \
1bbbfc50 1242 POPSTACK; \
9850bf21
RH
1243 CATCH_SET(multicall_oldcatch); \
1244 LEAVE; \
1bbbfc50 1245 SPAGAIN; \
9850bf21 1246 } STMT_END
b3ca2e83
NC
1247
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 */