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