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