Move retop first in structs block_sub, block_format and block_eval.
[p5sagit/p5-mst-13.2.git] / cop.h
1 /*    cop.h
2  *
3  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
4  *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
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  *
9  * Control ops (cops) are one of the three ops OP_NEXTSTATE, OP_DBSTATE,
10  * and OP_SETSTATE that (loosely speaking) are separate statements.
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,
13  * and thus can be used to determine our current state.
14  */
15
16 /* A jmpenv packages the state required to perform a proper non-local jump.
17  * Note that there is a start_env initialized when perl starts, and top_env
18  * points to this initially, so top_env should always be non-null.
19  *
20  * Existence of a non-null top_env->je_prev implies it is valid to call
21  * longjmp() at that runlevel (we make sure start_env.je_prev is always
22  * null to ensure this).
23  *
24  * je_mustcatch, when set at any runlevel to TRUE, means eval ops must
25  * establish a local jmpenv to handle exception traps.  Care must be taken
26  * to restore the previous value of je_mustcatch before exiting the
27  * stack frame iff JMPENV_PUSH was not called in that stack frame.
28  * GSAR 97-03-27
29  */
30
31 struct jmpenv {
32     struct jmpenv *     je_prev;
33     Sigjmp_buf          je_buf;         /* only for use if !je_throw */
34     int                 je_ret;         /* last exception thrown */
35     bool                je_mustcatch;   /* need to call longjmp()? */
36 };
37
38 typedef struct jmpenv JMPENV;
39
40 #ifdef OP_IN_REGISTER
41 #define OP_REG_TO_MEM   PL_opsave = op
42 #define OP_MEM_TO_REG   op = PL_opsave
43 #else
44 #define OP_REG_TO_MEM   NOOP
45 #define OP_MEM_TO_REG   NOOP
46 #endif
47
48 /*
49  * How to build the first jmpenv.
50  *
51  * top_env needs to be non-zero. It points to an area
52  * in which longjmp() stuff is stored, as C callstack
53  * info there at least is thread specific this has to
54  * be per-thread. Otherwise a 'die' in a thread gives
55  * that thread the C stack of last thread to do an eval {}!
56  */
57
58 #define JMPENV_BOOTSTRAP \
59     STMT_START {                                \
60         Zero(&PL_start_env, 1, JMPENV);         \
61         PL_start_env.je_ret = -1;               \
62         PL_start_env.je_mustcatch = TRUE;       \
63         PL_top_env = &PL_start_env;             \
64     } STMT_END
65
66 /*
67  *   PERL_FLEXIBLE_EXCEPTIONS
68  * 
69  * All the flexible exceptions code has been removed.
70  * See the following threads for details:
71  *
72  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-07/msg00378.html
73  * 
74  * Joshua's original patches (which weren't applied) and discussion:
75  * 
76  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01396.html
77  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01489.html
78  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01491.html
79  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01608.html
80  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02144.html
81  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02998.html
82  * 
83  * Chip's reworked patch and discussion:
84  * 
85  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1999-03/msg00520.html
86  * 
87  * The flaw in these patches (which went unnoticed at the time) was
88  * that they moved some code that could potentially die() out of the
89  * region protected by the setjmp()s.  This caused exceptions within
90  * END blocks and such to not be handled by the correct setjmp().
91  * 
92  * The original patches that introduces flexible exceptions were:
93  *
94  *   http://public.activestate.com/cgi-bin/perlbrowse?patch=3386
95  *   http://public.activestate.com/cgi-bin/perlbrowse?patch=5162
96  */
97
98 #define dJMPENV         JMPENV cur_env
99
100 #define JMPENV_PUSH(v) \
101     STMT_START {                                                        \
102         DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n",     \
103                          (void*)&cur_env, (void*)PL_top_env));                  \
104         cur_env.je_prev = PL_top_env;                                   \
105         OP_REG_TO_MEM;                                                  \
106         cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK);              \
107         OP_MEM_TO_REG;                                                  \
108         PL_top_env = &cur_env;                                          \
109         cur_env.je_mustcatch = FALSE;                                   \
110         (v) = cur_env.je_ret;                                           \
111     } STMT_END
112
113 #define JMPENV_POP \
114     STMT_START {                                                        \
115         DEBUG_l(Perl_deb(aTHX_ "popping jumplevel was %p, now %p\n",    \
116                          (void*)PL_top_env, (void*)cur_env.je_prev));                   \
117         PL_top_env = cur_env.je_prev;                                   \
118     } STMT_END
119
120 #define JMPENV_JUMP(v) \
121     STMT_START {                                                \
122         OP_REG_TO_MEM;                                          \
123         if (PL_top_env->je_prev)                                \
124             PerlProc_longjmp(PL_top_env->je_buf, (v));          \
125         if ((v) == 2)                                           \
126             PerlProc_exit(STATUS_EXIT);                         \
127         PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");     \
128         PerlProc_exit(1);                                       \
129     } STMT_END
130
131 #define CATCH_GET               (PL_top_env->je_mustcatch)
132 #define CATCH_SET(v)            (PL_top_env->je_mustcatch = (v))
133
134
135 #include "mydtrace.h"
136
137 struct cop {
138     BASEOP
139     /* On LP64 putting this here takes advantage of the fact that BASEOP isn't
140        an exact multiple of 8 bytes to save structure padding.  */
141     line_t      cop_line;       /* line # of this command */
142     char *      cop_label;      /* label for this construct */
143 #ifdef USE_ITHREADS
144     char *      cop_stashpv;    /* package line was compiled in */
145     char *      cop_file;       /* file name the following line # is from */
146 #else
147     HV *        cop_stash;      /* package line was compiled in */
148     GV *        cop_filegv;     /* file the following line # is from */
149 #endif
150     U32         cop_hints;      /* hints bits from pragmata */
151     U32         cop_seq;        /* parse sequence number */
152     /* Beware. mg.c and warnings.pl assume the type of this is STRLEN *:  */
153     STRLEN *    cop_warnings;   /* lexical warnings bitmask */
154     /* compile time state of %^H.  See the comment in op.c for how this is
155        used to recreate a hash to return from caller.  */
156     struct refcounted_he * cop_hints_hash;
157 };
158
159 #ifdef USE_ITHREADS
160 #  define CopFILE(c)            ((c)->cop_file)
161 #  define CopFILEGV(c)          (CopFILE(c) \
162                                  ? gv_fetchfile(CopFILE(c)) : NULL)
163                                  
164 #  ifdef NETWARE
165 #    define CopFILE_set(c,pv)   ((c)->cop_file = savepv(pv))
166 #    define CopFILE_setn(c,pv,l)  ((c)->cop_file = savepv((pv),(l)))
167 #  else
168 #    define CopFILE_set(c,pv)   ((c)->cop_file = savesharedpv(pv))
169 #    define CopFILE_setn(c,pv,l)  ((c)->cop_file = savesharedpvn((pv),(l)))
170 #  endif
171
172 #  define CopFILESV(c)          (CopFILE(c) \
173                                  ? GvSV(gv_fetchfile(CopFILE(c))) : NULL)
174 #  define CopFILEAV(c)          (CopFILE(c) \
175                                  ? GvAV(gv_fetchfile(CopFILE(c))) : NULL)
176 #  ifdef DEBUGGING
177 #    define CopFILEAVx(c)       (assert(CopFILE(c)), \
178                                    GvAV(gv_fetchfile(CopFILE(c))))
179 #  else
180 #    define CopFILEAVx(c)       (GvAV(gv_fetchfile(CopFILE(c))))
181 #  endif
182 #  define CopSTASHPV(c)         ((c)->cop_stashpv)
183
184 #  ifdef NETWARE
185 #    define CopSTASHPV_set(c,pv)        ((c)->cop_stashpv = ((pv) ? savepv(pv) : NULL))
186 #  else
187 #    define CopSTASHPV_set(c,pv)        ((c)->cop_stashpv = savesharedpv(pv))
188 #  endif
189
190 #  define CopSTASH(c)           (CopSTASHPV(c) \
191                                  ? gv_stashpv(CopSTASHPV(c),GV_ADD) : NULL)
192 #  define CopSTASH_set(c,hv)    CopSTASHPV_set(c, (hv) ? HvNAME_get(hv) : NULL)
193 #  define CopSTASH_eq(c,hv)     ((hv) && stashpv_hvname_match(c,hv))
194 #  define CopLABEL(c)           ((c)->cop_label)
195 #  define CopLABEL_set(c,pv)    (CopLABEL(c) = (pv))
196 #  ifdef NETWARE
197 #    define CopSTASH_free(c) SAVECOPSTASH_FREE(c)
198 #    define CopFILE_free(c) SAVECOPFILE_FREE(c)
199 #    define CopLABEL_free(c) SAVECOPLABEL_FREE(c)
200 #    define CopLABEL_alloc(pv)  ((pv)?savepv(pv):NULL)
201 #  else
202 #    define CopSTASH_free(c)    PerlMemShared_free(CopSTASHPV(c))
203 #    define CopFILE_free(c)     (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = NULL))
204 #    define CopLABEL_free(c)    (PerlMemShared_free(CopLABEL(c)),(CopLABEL(c) = NULL))
205 #    define CopLABEL_alloc(pv)  ((pv)?savesharedpv(pv):NULL)
206 #  endif
207 #else
208 #  define CopFILEGV(c)          ((c)->cop_filegv)
209 #  define CopFILEGV_set(c,gv)   ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
210 #  define CopFILE_set(c,pv)     CopFILEGV_set((c), gv_fetchfile(pv))
211 #  define CopFILE_setn(c,pv,l)  CopFILEGV_set((c), gv_fetchfile_flags((pv),(l),0))
212 #  define CopFILESV(c)          (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : NULL)
213 #  define CopFILEAV(c)          (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : NULL)
214 #  ifdef DEBUGGING
215 #    define CopFILEAVx(c)       (assert(CopFILEGV(c)), GvAV(CopFILEGV(c)))
216 #  else
217 #    define CopFILEAVx(c)       (GvAV(CopFILEGV(c)))
218 # endif
219 #  define CopFILE(c)            (CopFILEGV(c) && GvSV(CopFILEGV(c)) \
220                                     ? SvPVX(GvSV(CopFILEGV(c))) : NULL)
221 #  define CopSTASH(c)           ((c)->cop_stash)
222 #  define CopLABEL(c)           ((c)->cop_label)
223 #  define CopSTASH_set(c,hv)    ((c)->cop_stash = (hv))
224 #  define CopSTASHPV(c)         (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : NULL)
225    /* cop_stash is not refcounted */
226 #  define CopSTASHPV_set(c,pv)  CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
227 #  define CopSTASH_eq(c,hv)     (CopSTASH(c) == (hv))
228 #  define CopLABEL_alloc(pv)    ((pv)?savepv(pv):NULL)
229 #  define CopLABEL_set(c,pv)    (CopLABEL(c) = (pv))
230 #  define CopSTASH_free(c)      
231 #  define CopFILE_free(c)       (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL))
232 #  define CopLABEL_free(c)      (Safefree(CopLABEL(c)),(CopLABEL(c) = NULL))
233
234 #endif /* USE_ITHREADS */
235
236 #define CopSTASH_ne(c,hv)       (!CopSTASH_eq(c,hv))
237 #define CopLINE(c)              ((c)->cop_line)
238 #define CopLINE_inc(c)          (++CopLINE(c))
239 #define CopLINE_dec(c)          (--CopLINE(c))
240 #define CopLINE_set(c,l)        (CopLINE(c) = (l))
241
242 /* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */
243 #ifdef MACOS_TRADITIONAL
244 #  define OutCopFILE(c) MacPerl_MPWFileName(CopFILE(c))
245 #else
246 #  define OutCopFILE(c) CopFILE(c)
247 #endif
248
249 /* If $[ is non-zero, it's stored in cop_hints under the key "$[", and
250    HINT_ARYBASE is set to indicate this.
251    Setting it is ineficient due to the need to create 2 mortal SVs, but as
252    using $[ is highly discouraged, no sane Perl code will be using it.  */
253 #define CopARYBASE_get(c)       \
254         ((CopHINTS_get(c) & HINT_ARYBASE)                               \
255          ? SvIV(Perl_refcounted_he_fetch(aTHX_ (c)->cop_hints_hash, 0,  \
256                                          "$[", 2, 0, 0))                \
257          : 0)
258 #define CopARYBASE_set(c, b) STMT_START { \
259         if (b || ((c)->cop_hints & HINT_ARYBASE)) {                     \
260             (c)->cop_hints |= HINT_ARYBASE;                             \
261             if ((c) == &PL_compiling)                                   \
262                 PL_hints |= HINT_LOCALIZE_HH | HINT_ARYBASE;            \
263             (c)->cop_hints_hash                                         \
264                = Perl_refcounted_he_new(aTHX_ (c)->cop_hints_hash,      \
265                                         newSVpvs_flags("$[", SVs_TEMP), \
266                                         sv_2mortal(newSViv(b)));        \
267         }                                                               \
268     } STMT_END
269
270 /* FIXME NATIVE_HINTS if this is changed from op_private (see perl.h)  */
271 #define CopHINTS_get(c)         ((c)->cop_hints + 0)
272 #define CopHINTS_set(c, h)      STMT_START {                            \
273                                     (c)->cop_hints = (h);               \
274                                 } STMT_END
275
276 /*
277  * Here we have some enormously heavy (or at least ponderous) wizardry.
278  */
279
280 /* subroutine context */
281 struct block_sub {
282     OP *        retop;  /* op to execute on exit from sub */
283     /* Above here is the same for sub, format and eval.  */
284     CV *        cv;
285     U8          hasargs;
286     U8          lval;           /* XXX merge lval and hasargs? */
287     /* Above here is the same for sub and format.  */
288     AV *        savearray;
289     AV *        argarray;
290     I32         olddepth;
291     PAD         *oldcomppad;
292 };
293
294
295 /* format context */
296 struct block_format {
297     OP *        retop;  /* op to execute on exit from sub */
298     /* Above here is the same for sub, format and eval.  */
299     CV *        cv;
300     U8          hasargs;
301     U8          lval;           /* XXX merge lval and hasargs? */
302     /* Above here is the same for sub and format.  */
303     GV *        gv;
304     GV *        dfoutgv;
305 };
306
307 /* base for the next two macros. Don't use directly.
308  * Note that the refcnt of the cv is incremented twice;  The CX one is
309  * decremented by LEAVESUB, the other by LEAVE. */
310
311 #define PUSHSUB_BASE(cx)                                                \
312         ENTRY_PROBE(GvENAME(CvGV(cv)),                                  \
313                 CopFILE((COP*)CvSTART(cv)),                             \
314                 CopLINE((COP*)CvSTART(cv)));                            \
315                                                                         \
316         cx->blk_sub.cv = cv;                                            \
317         cx->blk_sub.olddepth = CvDEPTH(cv);                             \
318         cx->blk_sub.hasargs = hasargs;                                  \
319         cx->blk_sub.retop = NULL;                                       \
320         if (!CvDEPTH(cv)) {                                             \
321             SvREFCNT_inc_simple_void_NN(cv);                            \
322             SvREFCNT_inc_simple_void_NN(cv);                            \
323             SAVEFREESV(cv);                                             \
324         }
325
326
327 #define PUSHSUB(cx)                                                     \
328         PUSHSUB_BASE(cx)                                                \
329         cx->blk_sub.lval = PL_op->op_private &                          \
330                               (OPpLVAL_INTRO|OPpENTERSUB_INARGS);
331
332 /* variant for use by OP_DBSTATE, where op_private holds hint bits */
333 #define PUSHSUB_DB(cx)                                                  \
334         PUSHSUB_BASE(cx)                                                \
335         cx->blk_sub.lval = 0;
336
337
338 #define PUSHFORMAT(cx, retop)                                           \
339         cx->blk_format.cv = cv;                                         \
340         cx->blk_format.gv = gv;                                         \
341         cx->blk_format.retop = (retop);                                 \
342         cx->blk_format.hasargs = 0;                                     \
343         cx->blk_format.dfoutgv = PL_defoutgv;                           \
344         SvREFCNT_inc_void(cx->blk_format.dfoutgv)
345
346 #define POP_SAVEARRAY()                                         \
347     STMT_START {                                                        \
348         SvREFCNT_dec(GvAV(PL_defgv));                                   \
349         GvAV(PL_defgv) = cx->blk_sub.savearray;                         \
350     } STMT_END
351
352 /* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't
353  * leave any (a fast av_clear(ary), basically) */
354 #define CLEAR_ARGARRAY(ary) \
355     STMT_START {                                                        \
356         AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary);                      \
357         AvARRAY(ary) = AvALLOC(ary);                                    \
358         AvFILLp(ary) = -1;                                              \
359     } STMT_END
360
361 #define POPSUB(cx,sv)                                                   \
362     STMT_START {                                                        \
363         RETURN_PROBE(GvENAME(CvGV((CV*)cx->blk_sub.cv)),                \
364                 CopFILE((COP*)CvSTART((CV*)cx->blk_sub.cv)),            \
365                 CopLINE((COP*)CvSTART((CV*)cx->blk_sub.cv)));           \
366                                                                         \
367         if (cx->blk_sub.hasargs) {                                      \
368             POP_SAVEARRAY();                                            \
369             /* abandon @_ if it got reified */                          \
370             if (AvREAL(cx->blk_sub.argarray)) {                         \
371                 const SSize_t fill = AvFILLp(cx->blk_sub.argarray);     \
372                 SvREFCNT_dec(cx->blk_sub.argarray);                     \
373                 cx->blk_sub.argarray = newAV();                         \
374                 av_extend(cx->blk_sub.argarray, fill);                  \
375                 AvREIFY_only(cx->blk_sub.argarray);                     \
376                 CX_CURPAD_SV(cx->blk_sub, 0) = (SV*)cx->blk_sub.argarray;       \
377             }                                                           \
378             else {                                                      \
379                 CLEAR_ARGARRAY(cx->blk_sub.argarray);                   \
380             }                                                           \
381         }                                                               \
382         sv = (SV*)cx->blk_sub.cv;                                       \
383         if (sv && (CvDEPTH((CV*)sv) = cx->blk_sub.olddepth))            \
384             sv = NULL;                                          \
385     } STMT_END
386
387 #define LEAVESUB(sv)                                                    \
388     STMT_START {                                                        \
389         if (sv)                                                         \
390             SvREFCNT_dec(sv);                                           \
391     } STMT_END
392
393 #define POPFORMAT(cx)                                                   \
394         setdefout(cx->blk_format.dfoutgv);                              \
395         SvREFCNT_dec(cx->blk_format.dfoutgv);
396
397 /* eval context */
398 struct block_eval {
399     OP *        retop;  /* op to execute on exit from eval */
400     /* Above here is the same for sub, format and eval.  */
401     U8          old_in_eval;
402     U16         old_op_type;
403     SV *        old_namesv;
404     OP *        old_eval_root;
405     SV *        cur_text;
406     CV *        cv;
407     JMPENV *    cur_top_env; /* value of PL_top_env when eval CX created */
408 };
409
410 #define PUSHEVAL(cx,n,fgv)                                              \
411     STMT_START {                                                        \
412         cx->blk_eval.old_in_eval = PL_in_eval;                          \
413         cx->blk_eval.old_op_type = PL_op->op_type;                      \
414         cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : NULL);            \
415         cx->blk_eval.old_eval_root = PL_eval_root;                      \
416         cx->blk_eval.cur_text = PL_parser ? PL_parser->linestr : NULL;  \
417         cx->blk_eval.cv = NULL; /* set by doeval(), as applicable */    \
418         cx->blk_eval.retop = NULL;                                      \
419         cx->blk_eval.cur_top_env = PL_top_env;                          \
420     } STMT_END
421
422 #define POPEVAL(cx)                                                     \
423     STMT_START {                                                        \
424         PL_in_eval = cx->blk_eval.old_in_eval;                          \
425         optype = cx->blk_eval.old_op_type;                              \
426         PL_eval_root = cx->blk_eval.old_eval_root;                      \
427         if (cx->blk_eval.old_namesv)                                    \
428             sv_2mortal(cx->blk_eval.old_namesv);                        \
429     } STMT_END
430
431 /* loop context */
432 struct block_loop {
433     I32         resetsp;
434     LOOP *      my_op;  /* My op, that contains redo, next and last ops.  */
435     /* (except for non_ithreads we need to modify next_op in pp_ctl.c, hence
436         why next_op is conditionally defined below.)  */
437 #ifdef USE_ITHREADS
438     void *      iterdata;
439     PAD         *oldcomppad;
440 #else
441     OP *        next_op;
442     SV **       itervar;
443 #endif
444     SV *        itersave;
445     /* (from inspection of source code) for a .. range of strings this is the
446        current string.  */
447     SV *        iterlval;
448     /* (from inspection of source code) for a foreach loop this is the array
449        being iterated over. For a .. range of numbers it's the current value.
450        A check is often made on the SvTYPE of iterary to determine whether
451        we are iterating over an array or a range. (numbers or strings)  */
452     AV *        iterary;
453     IV          iterix;
454     /* (from inspection of source code) for a .. range of numbers this is the
455        maximum value.  */
456     IV          itermax;
457 };
458 /* It might be possible to squeeze this structure further. As best I can tell
459    itermax and iterlval are never used at the same time, so it might be possible
460    to make them into a union. However, I'm not confident that there are enough
461    flag bits/NULLable pointers in this structure alone to encode which is
462    active. There is, however, U8 of space free in struct block, which could be
463    used. Right now it may not be worth squeezing this structure further, as it's
464    the largest part of struct block, and currently struct block is 64 bytes on
465    an ILP32 system, which will give good cache alignment.
466 */
467
468 #ifdef USE_ITHREADS
469 #  define CxITERVAR(c)                                                  \
470         ((c)->blk_loop.iterdata                                         \
471          ? (CxPADLOOP(cx)                                               \
472             ? &CX_CURPAD_SV( (c)->blk_loop,                             \
473                     INT2PTR(PADOFFSET, (c)->blk_loop.iterdata))         \
474             : &GvSV((GV*)(c)->blk_loop.iterdata))                       \
475          : (SV**)NULL)
476 #  define CX_ITERDATA_SET(cx,idata)                                     \
477         CX_CURPAD_SAVE(cx->blk_loop);                                   \
478         if ((cx->blk_loop.iterdata = (idata)))                          \
479             cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx));       \
480         else                                                            \
481             cx->blk_loop.itersave = NULL;
482 #else
483 #  define CxITERVAR(c)          ((c)->blk_loop.itervar)
484 #  define CX_ITERDATA_SET(cx,ivar)                                      \
485         if ((cx->blk_loop.itervar = (SV**)(ivar)))                      \
486             cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx));       \
487         else                                                            \
488             cx->blk_loop.itersave = NULL;
489 #endif
490 #define CxLABEL(c)      (0 + (c)->blk_oldcop->cop_label)
491
492 #ifdef USE_ITHREADS
493 #  define PUSHLOOP_OP_NEXT              /* No need to do anything.  */
494 #  define CX_LOOP_NEXTOP_GET(cx)        ((cx)->blk_loop.my_op->op_nextop + 0)
495 #else
496 #  define PUSHLOOP_OP_NEXT              cx->blk_loop.next_op = cLOOP->op_nextop
497 #  define CX_LOOP_NEXTOP_GET(cx)        ((cx)->blk_loop.next_op + 0)
498 #endif
499
500 #define PUSHLOOP(cx, dat, s)                                            \
501         cx->blk_loop.resetsp = s - PL_stack_base;                       \
502         cx->blk_loop.my_op = cLOOP;                                     \
503         PUSHLOOP_OP_NEXT;                                               \
504         cx->blk_loop.iterlval = NULL;                                   \
505         cx->blk_loop.iterary = NULL;                                    \
506         cx->blk_loop.iterix = -1;                                       \
507         CX_ITERDATA_SET(cx,dat);
508
509 #define POPLOOP(cx)                                                     \
510         SvREFCNT_dec(cx->blk_loop.iterlval);                            \
511         if (CxITERVAR(cx)) {                                            \
512             if (SvPADMY(cx->blk_loop.itersave)) {                       \
513                 SV ** const s_v_p = CxITERVAR(cx);                      \
514                 sv_2mortal(*s_v_p);                                     \
515                 *s_v_p = cx->blk_loop.itersave;                         \
516             }                                                           \
517             else {                                                      \
518                 SvREFCNT_dec(cx->blk_loop.itersave);                    \
519             }                                                           \
520         }                                                               \
521         if (cx->blk_loop.iterary && cx->blk_loop.iterary != PL_curstack)\
522             SvREFCNT_dec(cx->blk_loop.iterary);
523
524 /* given/when context */
525 struct block_givwhen {
526         OP *leave_op;
527 };
528
529 #define PUSHGIVEN(cx)                                                   \
530         cx->blk_givwhen.leave_op = cLOGOP->op_other;
531
532 #define PUSHWHEN PUSHGIVEN
533
534 /* context common to subroutines, evals and loops */
535 struct block {
536     U16         blku_type;      /* what kind of context this is */
537     U8          blku_gimme;     /* is this block running in list context? */
538     U8          blku_spare;     /* Padding to match with struct subst */
539     I32         blku_oldsp;     /* stack pointer to copy stuff down to */
540     COP *       blku_oldcop;    /* old curcop pointer */
541     I32         blku_oldmarksp; /* mark stack index */
542     I32         blku_oldscopesp;        /* scope stack index */
543     PMOP *      blku_oldpm;     /* values of pattern match vars */
544
545     union {
546         struct block_sub        blku_sub;
547         struct block_format     blku_format;
548         struct block_eval       blku_eval;
549         struct block_loop       blku_loop;
550         struct block_givwhen    blku_givwhen;
551     } blk_u;
552 };
553 #define blk_oldsp       cx_u.cx_blk.blku_oldsp
554 #define blk_oldcop      cx_u.cx_blk.blku_oldcop
555 #define blk_oldmarksp   cx_u.cx_blk.blku_oldmarksp
556 #define blk_oldscopesp  cx_u.cx_blk.blku_oldscopesp
557 #define blk_oldpm       cx_u.cx_blk.blku_oldpm
558 #define blk_gimme       cx_u.cx_blk.blku_gimme
559 #define blk_sub         cx_u.cx_blk.blk_u.blku_sub
560 #define blk_format      cx_u.cx_blk.blk_u.blku_format
561 #define blk_eval        cx_u.cx_blk.blk_u.blku_eval
562 #define blk_loop        cx_u.cx_blk.blk_u.blku_loop
563 #define blk_givwhen     cx_u.cx_blk.blk_u.blku_givwhen
564
565 /* Enter a block. */
566 #define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix],            \
567         cx->cx_type             = t,                                    \
568         cx->blk_oldsp           = sp - PL_stack_base,                   \
569         cx->blk_oldcop          = PL_curcop,                            \
570         cx->blk_oldmarksp       = PL_markstack_ptr - PL_markstack,      \
571         cx->blk_oldscopesp      = PL_scopestack_ix,                     \
572         cx->blk_oldpm           = PL_curpm,                             \
573         cx->blk_gimme           = (U8)gimme;                            \
574         DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n", \
575                     (long)cxstack_ix, PL_block_type[CxTYPE(cx)]); )
576
577 /* Exit a block (RETURN and LAST). */
578 #define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--],                    \
579         newsp            = PL_stack_base + cx->blk_oldsp,               \
580         PL_curcop        = cx->blk_oldcop,                              \
581         PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp,            \
582         PL_scopestack_ix = cx->blk_oldscopesp,                          \
583         pm               = cx->blk_oldpm,                               \
584         gimme            = cx->blk_gimme;                               \
585         DEBUG_SCOPE("POPBLOCK");                                        \
586         DEBUG_l( PerlIO_printf(Perl_debug_log, "Leaving block %ld, type %s\n",          \
587                     (long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); )
588
589 /* Continue a block elsewhere (NEXT and REDO). */
590 #define TOPBLOCK(cx) cx  = &cxstack[cxstack_ix],                        \
591         PL_stack_sp      = PL_stack_base + cx->blk_oldsp,               \
592         PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp,            \
593         PL_scopestack_ix = cx->blk_oldscopesp,                          \
594         PL_curpm         = cx->blk_oldpm;                               \
595         DEBUG_SCOPE("TOPBLOCK");
596
597 /* substitution context */
598 struct subst {
599     U16         sbu_type;       /* what kind of context this is */
600     U8          sbu_once;       /* Actually both booleans, but U8 to matches */
601     U8          sbu_rxtainted;  /* struct block */
602     I32         sbu_iters;
603     I32         sbu_maxiters;
604     I32         sbu_rflags;
605     I32         sbu_oldsave;
606     char *      sbu_orig;
607     SV *        sbu_dstr;
608     SV *        sbu_targ;
609     char *      sbu_s;
610     char *      sbu_m;
611     char *      sbu_strend;
612     void *      sbu_rxres;
613     REGEXP *    sbu_rx;
614 };
615 #define sb_iters        cx_u.cx_subst.sbu_iters
616 #define sb_maxiters     cx_u.cx_subst.sbu_maxiters
617 #define sb_rflags       cx_u.cx_subst.sbu_rflags
618 #define sb_oldsave      cx_u.cx_subst.sbu_oldsave
619 #define sb_once         cx_u.cx_subst.sbu_once
620 #define sb_rxtainted    cx_u.cx_subst.sbu_rxtainted
621 #define sb_orig         cx_u.cx_subst.sbu_orig
622 #define sb_dstr         cx_u.cx_subst.sbu_dstr
623 #define sb_targ         cx_u.cx_subst.sbu_targ
624 #define sb_s            cx_u.cx_subst.sbu_s
625 #define sb_m            cx_u.cx_subst.sbu_m
626 #define sb_strend       cx_u.cx_subst.sbu_strend
627 #define sb_rxres        cx_u.cx_subst.sbu_rxres
628 #define sb_rx           cx_u.cx_subst.sbu_rx
629
630 #define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix],                 \
631         cx->sb_iters            = iters,                                \
632         cx->sb_maxiters         = maxiters,                             \
633         cx->sb_rflags           = r_flags,                              \
634         cx->sb_oldsave          = oldsave,                              \
635         cx->sb_once             = once,                                 \
636         cx->sb_rxtainted        = rxtainted,                            \
637         cx->sb_orig             = orig,                                 \
638         cx->sb_dstr             = dstr,                                 \
639         cx->sb_targ             = targ,                                 \
640         cx->sb_s                = s,                                    \
641         cx->sb_m                = m,                                    \
642         cx->sb_strend           = strend,                               \
643         cx->sb_rxres            = NULL,                                 \
644         cx->sb_rx               = rx,                                   \
645         cx->cx_type             = CXt_SUBST;                            \
646         rxres_save(&cx->sb_rxres, rx);                                  \
647         (void)ReREFCNT_inc(rx)
648
649 #define POPSUBST(cx) cx = &cxstack[cxstack_ix--];                       \
650         rxres_free(&cx->sb_rxres);                                      \
651         ReREFCNT_dec(cx->sb_rx)
652
653 struct context {
654     union {
655         struct block    cx_blk;
656         struct subst    cx_subst;
657     } cx_u;
658 };
659 #define cx_type cx_u.cx_subst.sbu_type
660
661 #define CXTYPEMASK      0xff
662 #define CXt_NULL        0
663 #define CXt_SUB         1
664 #define CXt_EVAL        2
665 #define CXt_LOOP        3
666 #define CXt_SUBST       4
667 #define CXt_BLOCK       5
668 #define CXt_FORMAT      6
669 #define CXt_GIVEN       7
670 #define CXt_WHEN        8
671
672 /* private flags for CXt_SUB and CXt_NULL */
673 #define CXp_MULTICALL   0x00000400      /* part of a multicall (so don't
674                                            tear down context on exit). */ 
675
676 /* private flags for CXt_EVAL */
677 #define CXp_REAL        0x00000100      /* truly eval'', not a lookalike */
678 #define CXp_TRYBLOCK    0x00000200      /* eval{}, not eval'' or similar */
679
680 /* private flags for CXt_LOOP */
681 #define CXp_FOREACH     0x00000200      /* a foreach loop */
682 #define CXp_FOR_DEF     0x00000400      /* foreach using $_ */
683 #ifdef USE_ITHREADS
684 #  define CXp_PADVAR    0x00000100      /* itervar lives on pad, iterdata
685                                            has pad offset; if not set,
686                                            iterdata holds GV* */
687 #  define CxPADLOOP(c)  (((c)->cx_type & (CXt_LOOP|CXp_PADVAR))         \
688                          == (CXt_LOOP|CXp_PADVAR))
689 #endif
690
691 #define CxTYPE(c)       ((c)->cx_type & CXTYPEMASK)
692 #define CxMULTICALL(c)  (((c)->cx_type & CXp_MULTICALL)                 \
693                          == CXp_MULTICALL)
694 #define CxREALEVAL(c)   (((c)->cx_type & (CXTYPEMASK|CXp_REAL))         \
695                          == (CXt_EVAL|CXp_REAL))
696 #define CxTRYBLOCK(c)   (((c)->cx_type & (CXTYPEMASK|CXp_TRYBLOCK))     \
697                          == (CXt_EVAL|CXp_TRYBLOCK))
698 #define CxFOREACH(c)    (((c)->cx_type & (CXTYPEMASK|CXp_FOREACH))      \
699                          == (CXt_LOOP|CXp_FOREACH))
700 #define CxFOREACHDEF(c) (((c)->cx_type & (CXTYPEMASK|CXp_FOREACH|CXp_FOR_DEF))\
701                          == (CXt_LOOP|CXp_FOREACH|CXp_FOR_DEF))
702
703 #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
704
705 /* 
706 =head1 "Gimme" Values
707 */
708
709 /*
710 =for apidoc AmU||G_SCALAR
711 Used to indicate scalar context.  See C<GIMME_V>, C<GIMME>, and
712 L<perlcall>.
713
714 =for apidoc AmU||G_ARRAY
715 Used to indicate list context.  See C<GIMME_V>, C<GIMME> and
716 L<perlcall>.
717
718 =for apidoc AmU||G_VOID
719 Used to indicate void context.  See C<GIMME_V> and L<perlcall>.
720
721 =for apidoc AmU||G_DISCARD
722 Indicates that arguments returned from a callback should be discarded.  See
723 L<perlcall>.
724
725 =for apidoc AmU||G_EVAL
726
727 Used to force a Perl C<eval> wrapper around a callback.  See
728 L<perlcall>.
729
730 =for apidoc AmU||G_NOARGS
731
732 Indicates that no arguments are being sent to a callback.  See
733 L<perlcall>.
734
735 =cut
736 */
737
738 #define G_SCALAR        0
739 #define G_ARRAY         1
740 #define G_VOID          128     /* skip this bit when adding flags below */
741
742 /* extra flags for Perl_call_* routines */
743 #define G_DISCARD       2       /* Call FREETMPS.
744                                    Don't change this without consulting the
745                                    hash actions codes defined in hv.h */
746 #define G_EVAL          4       /* Assume eval {} around subroutine call. */
747 #define G_NOARGS        8       /* Don't construct a @_ array. */
748 #define G_KEEPERR      16       /* Append errors to $@, don't overwrite it */
749 #define G_NODEBUG      32       /* Disable debugging at toplevel.  */
750 #define G_METHOD       64       /* Calling method. */
751 #define G_FAKINGEVAL  256       /* Faking an eval context for call_sv or
752                                    fold_constants. */
753
754 /* flag bits for PL_in_eval */
755 #define EVAL_NULL       0       /* not in an eval */
756 #define EVAL_INEVAL     1       /* some enclosing scope is an eval */
757 #define EVAL_WARNONLY   2       /* used by yywarn() when calling yyerror() */
758 #define EVAL_KEEPERR    4       /* set by Perl_call_sv if G_KEEPERR */
759 #define EVAL_INREQUIRE  8       /* The code is being required. */
760
761 /* Support for switching (stack and block) contexts.
762  * This ensures magic doesn't invalidate local stack and cx pointers.
763  */
764
765 #define PERLSI_UNKNOWN          -1
766 #define PERLSI_UNDEF            0
767 #define PERLSI_MAIN             1
768 #define PERLSI_MAGIC            2
769 #define PERLSI_SORT             3
770 #define PERLSI_SIGNAL           4
771 #define PERLSI_OVERLOAD         5
772 #define PERLSI_DESTROY          6
773 #define PERLSI_WARNHOOK         7
774 #define PERLSI_DIEHOOK          8
775 #define PERLSI_REQUIRE          9
776
777 struct stackinfo {
778     AV *                si_stack;       /* stack for current runlevel */
779     PERL_CONTEXT *      si_cxstack;     /* context stack for runlevel */
780     struct stackinfo *  si_prev;
781     struct stackinfo *  si_next;
782     I32                 si_cxix;        /* current context index */
783     I32                 si_cxmax;       /* maximum allocated index */
784     I32                 si_type;        /* type of runlevel */
785     I32                 si_markoff;     /* offset where markstack begins for us.
786                                          * currently used only with DEBUGGING,
787                                          * but not #ifdef-ed for bincompat */
788 };
789
790 typedef struct stackinfo PERL_SI;
791
792 #define cxstack         (PL_curstackinfo->si_cxstack)
793 #define cxstack_ix      (PL_curstackinfo->si_cxix)
794 #define cxstack_max     (PL_curstackinfo->si_cxmax)
795
796 #ifdef DEBUGGING
797 #  define       SET_MARK_OFFSET \
798     PL_curstackinfo->si_markoff = PL_markstack_ptr - PL_markstack
799 #else
800 #  define       SET_MARK_OFFSET NOOP
801 #endif
802
803 #define PUSHSTACKi(type) \
804     STMT_START {                                                        \
805         PERL_SI *next = PL_curstackinfo->si_next;                       \
806         if (!next) {                                                    \
807             next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1);    \
808             next->si_prev = PL_curstackinfo;                            \
809             PL_curstackinfo->si_next = next;                            \
810         }                                                               \
811         next->si_type = type;                                           \
812         next->si_cxix = -1;                                             \
813         AvFILLp(next->si_stack) = 0;                                    \
814         SWITCHSTACK(PL_curstack,next->si_stack);                        \
815         PL_curstackinfo = next;                                         \
816         SET_MARK_OFFSET;                                                \
817     } STMT_END
818
819 #define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)
820
821 /* POPSTACK works with PL_stack_sp, so it may need to be bracketed by
822  * PUTBACK/SPAGAIN to flush/refresh any local SP that may be active */
823 #define POPSTACK \
824     STMT_START {                                                        \
825         dSP;                                                            \
826         PERL_SI * const prev = PL_curstackinfo->si_prev;                \
827         if (!prev) {                                                    \
828             PerlIO_printf(Perl_error_log, "panic: POPSTACK\n");         \
829             my_exit(1);                                                 \
830         }                                                               \
831         SWITCHSTACK(PL_curstack,prev->si_stack);                        \
832         /* don't free prev here, free them all at the END{} */          \
833         PL_curstackinfo = prev;                                         \
834     } STMT_END
835
836 #define POPSTACK_TO(s) \
837     STMT_START {                                                        \
838         while (PL_curstack != s) {                                      \
839             dounwind(-1);                                               \
840             POPSTACK;                                                   \
841         }                                                               \
842     } STMT_END
843
844 #define IN_PERL_COMPILETIME     (PL_curcop == &PL_compiling)
845 #define IN_PERL_RUNTIME         (PL_curcop != &PL_compiling)
846
847 /*
848 =head1 Multicall Functions
849
850 =for apidoc Ams||dMULTICALL
851 Declare local variables for a multicall. See L<perlcall/Lightweight Callbacks>.
852
853 =for apidoc Ams||PUSH_MULTICALL
854 Opening bracket for a lightweight callback.
855 See L<perlcall/Lightweight Callbacks>.
856
857 =for apidoc Ams||MULTICALL
858 Make a lightweight callback. See L<perlcall/Lightweight Callbacks>.
859
860 =for apidoc Ams||POP_MULTICALL
861 Closing bracket for a lightweight callback.
862 See L<perlcall/Lightweight Callbacks>.
863
864 =cut
865 */
866
867 #define dMULTICALL \
868     SV **newsp;                 /* set by POPBLOCK */                   \
869     PERL_CONTEXT *cx;                                                   \
870     CV *multicall_cv;                                                   \
871     OP *multicall_cop;                                                  \
872     bool multicall_oldcatch;                                            \
873     U8 hasargs = 0              /* used by PUSHSUB */
874
875 #define PUSH_MULTICALL(the_cv) \
876     STMT_START {                                                        \
877         CV * const _nOnclAshIngNamE_ = the_cv;                          \
878         CV * const cv = _nOnclAshIngNamE_;                              \
879         AV * const padlist = CvPADLIST(cv);                             \
880         ENTER;                                                          \
881         multicall_oldcatch = CATCH_GET;                                 \
882         SAVETMPS; SAVEVPTR(PL_op);                                      \
883         CATCH_SET(TRUE);                                                \
884         PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp);              \
885         PUSHSUB(cx);                                                    \
886         if (++CvDEPTH(cv) >= 2) {                                       \
887             PERL_STACK_OVERFLOW_CHECK();                                \
888             Perl_pad_push(aTHX_ padlist, CvDEPTH(cv));                  \
889         }                                                               \
890         SAVECOMPPAD();                                                  \
891         PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));                       \
892         multicall_cv = cv;                                              \
893         multicall_cop = CvSTART(cv);                                    \
894     } STMT_END
895
896 #define MULTICALL \
897     STMT_START {                                                        \
898         PL_op = multicall_cop;                                          \
899         CALLRUNOPS(aTHX);                                               \
900     } STMT_END
901
902 #define POP_MULTICALL \
903     STMT_START {                                                        \
904         LEAVESUB(multicall_cv);                                         \
905         CvDEPTH(multicall_cv)--;                                        \
906         POPBLOCK(cx,PL_curpm);                                          \
907         CATCH_SET(multicall_oldcatch);                                  \
908         LEAVE;                                                          \
909     } STMT_END
910
911 /*
912  * Local variables:
913  * c-indentation-style: bsd
914  * c-basic-offset: 4
915  * indent-tabs-mode: t
916  * End:
917  *
918  * ex: set ts=8 sts=4 sw=4 noet:
919  */