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