3 * Copyright (c) 1991-1999, Larry Wall
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
12 char * cop_label; /* label for this construct */
13 HV * cop_stash; /* package line was compiled in */
14 GV * cop_filegv; /* file the following line # is from */
15 U32 cop_seq; /* parse sequence number */
16 I32 cop_arybase; /* array base this line was compiled with */
17 line_t cop_line; /* line # of this command */
18 SV * cop_warnings; /* lexical warnings bitmask */
21 #define Nullcop Null(COP*)
24 * Here we have some enormously heavy (or at least ponderous) wizardry.
27 /* subroutine context */
34 #endif /* USE_THREADS */
38 U8 lval; /* XXX merge lval and hasargs? */
42 cx->blk_sub.cv = cv; \
43 cx->blk_sub.olddepth = CvDEPTH(cv); \
44 cx->blk_sub.hasargs = hasargs; \
45 cx->blk_sub.lval = PL_op->op_private & \
46 (OPpLVAL_INTRO|OPpENTERSUB_INARGS);
48 #define PUSHFORMAT(cx) \
49 cx->blk_sub.cv = cv; \
50 cx->blk_sub.gv = gv; \
51 cx->blk_sub.hasargs = 0; \
52 cx->blk_sub.dfoutgv = PL_defoutgv; \
53 (void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
56 { struct block_sub cxsub; \
61 cxsub = cx->blk_sub; /* because DESTROY may clobber *cx */
64 #define POPSAVEARRAY() NOOP
66 #define POPSAVEARRAY() \
68 SvREFCNT_dec(GvAV(PL_defgv)); \
69 GvAV(PL_defgv) = cxsub.savearray; \
71 #endif /* USE_THREADS */
74 if (cxsub.hasargs) { \
76 /* destroy arg array */ \
77 av_clear(cxsub.argarray); \
78 AvREAL_off(cxsub.argarray); \
79 AvREIFY_on(cxsub.argarray); \
82 if (!(CvDEPTH(cxsub.cv) = cxsub.olddepth)) \
83 SvREFCNT_dec(cxsub.cv); \
86 #define POPFORMAT(cx) \
87 setdefout(cx->blk_sub.dfoutgv); \
88 SvREFCNT_dec(cx->blk_sub.dfoutgv);
99 #define PUSHEVAL(cx,n,fgv) \
100 cx->blk_eval.old_in_eval = PL_in_eval; \
101 cx->blk_eval.old_op_type = PL_op->op_type; \
102 cx->blk_eval.old_name = n; \
103 cx->blk_eval.old_eval_root = PL_eval_root; \
104 cx->blk_eval.cur_text = PL_linestr;
106 #define POPEVAL(cx) \
107 PL_in_eval = cx->blk_eval.old_in_eval; \
108 optype = cx->blk_eval.old_op_type; \
109 PL_eval_root = cx->blk_eval.old_eval_root;
126 #define PUSHLOOP(cx, ivar, s) \
127 cx->blk_loop.label = PL_curcop->cop_label; \
128 cx->blk_loop.resetsp = s - PL_stack_base; \
129 cx->blk_loop.redo_op = cLOOP->op_redoop; \
130 cx->blk_loop.next_op = cLOOP->op_nextop; \
131 cx->blk_loop.last_op = cLOOP->op_lastop; \
132 if (cx->blk_loop.itervar = (ivar)) \
133 cx->blk_loop.itersave = SvREFCNT_inc(*cx->blk_loop.itervar);\
134 cx->blk_loop.iterlval = Nullsv; \
135 cx->blk_loop.iterary = Nullav; \
136 cx->blk_loop.iterix = -1;
138 #define POPLOOP(cx) \
139 { struct block_loop cxloop; \
143 #define POPLOOP1(cx) \
144 cxloop = cx->blk_loop; /* because DESTROY may clobber *cx */ \
145 newsp = PL_stack_base + cxloop.resetsp;
148 SvREFCNT_dec(cxloop.iterlval); \
149 if (cxloop.itervar) { \
150 sv_2mortal(*cxloop.itervar); \
151 *cxloop.itervar = cxloop.itersave; \
153 if (cxloop.iterary && cxloop.iterary != PL_curstack) \
154 SvREFCNT_dec(cxloop.iterary);
156 /* context common to subroutines, evals and loops */
158 I32 blku_oldsp; /* stack pointer to copy stuff down to */
159 COP * blku_oldcop; /* old curcop pointer */
160 I32 blku_oldretsp; /* return stack index */
161 I32 blku_oldmarksp; /* mark stack index */
162 I32 blku_oldscopesp; /* scope stack index */
163 PMOP * blku_oldpm; /* values of pattern match vars */
164 U8 blku_gimme; /* is this block running in list context? */
167 struct block_sub blku_sub;
168 struct block_eval blku_eval;
169 struct block_loop blku_loop;
172 #define blk_oldsp cx_u.cx_blk.blku_oldsp
173 #define blk_oldcop cx_u.cx_blk.blku_oldcop
174 #define blk_oldretsp cx_u.cx_blk.blku_oldretsp
175 #define blk_oldmarksp cx_u.cx_blk.blku_oldmarksp
176 #define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp
177 #define blk_oldpm cx_u.cx_blk.blku_oldpm
178 #define blk_gimme cx_u.cx_blk.blku_gimme
179 #define blk_sub cx_u.cx_blk.blk_u.blku_sub
180 #define blk_eval cx_u.cx_blk.blk_u.blku_eval
181 #define blk_loop cx_u.cx_blk.blk_u.blku_loop
184 #define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \
186 cx->blk_oldsp = sp - PL_stack_base, \
187 cx->blk_oldcop = PL_curcop, \
188 cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \
189 cx->blk_oldscopesp = PL_scopestack_ix, \
190 cx->blk_oldretsp = PL_retstack_ix, \
191 cx->blk_oldpm = PL_curpm, \
192 cx->blk_gimme = gimme; \
193 DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Entering block %ld, type %s\n", \
194 (long)cxstack_ix, PL_block_type[CxTYPE(cx)]); )
196 /* Exit a block (RETURN and LAST). */
197 #define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \
198 newsp = PL_stack_base + cx->blk_oldsp, \
199 PL_curcop = cx->blk_oldcop, \
200 PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
201 PL_scopestack_ix = cx->blk_oldscopesp, \
202 PL_retstack_ix = cx->blk_oldretsp, \
203 pm = cx->blk_oldpm, \
204 gimme = cx->blk_gimme; \
205 DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Leaving block %ld, type %s\n", \
206 (long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); )
208 /* Continue a block elsewhere (NEXT and REDO). */
209 #define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \
210 PL_stack_sp = PL_stack_base + cx->blk_oldsp, \
211 PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
212 PL_scopestack_ix = cx->blk_oldscopesp, \
213 PL_retstack_ix = cx->blk_oldretsp, \
214 PL_curpm = cx->blk_oldpm
216 /* substitution context */
233 #define sb_iters cx_u.cx_subst.sbu_iters
234 #define sb_maxiters cx_u.cx_subst.sbu_maxiters
235 #define sb_rflags cx_u.cx_subst.sbu_rflags
236 #define sb_oldsave cx_u.cx_subst.sbu_oldsave
237 #define sb_once cx_u.cx_subst.sbu_once
238 #define sb_rxtainted cx_u.cx_subst.sbu_rxtainted
239 #define sb_orig cx_u.cx_subst.sbu_orig
240 #define sb_dstr cx_u.cx_subst.sbu_dstr
241 #define sb_targ cx_u.cx_subst.sbu_targ
242 #define sb_s cx_u.cx_subst.sbu_s
243 #define sb_m cx_u.cx_subst.sbu_m
244 #define sb_strend cx_u.cx_subst.sbu_strend
245 #define sb_rxres cx_u.cx_subst.sbu_rxres
246 #define sb_rx cx_u.cx_subst.sbu_rx
248 #define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \
249 cx->sb_iters = iters, \
250 cx->sb_maxiters = maxiters, \
251 cx->sb_rflags = r_flags, \
252 cx->sb_oldsave = oldsave, \
253 cx->sb_once = once, \
254 cx->sb_rxtainted = rxtainted, \
255 cx->sb_orig = orig, \
256 cx->sb_dstr = dstr, \
257 cx->sb_targ = targ, \
260 cx->sb_strend = strend, \
261 cx->sb_rxres = Null(void*), \
263 cx->cx_type = CXt_SUBST; \
264 rxres_save(&cx->sb_rxres, rx)
266 #define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \
267 rxres_free(&cx->sb_rxres)
270 U32 cx_type; /* what kind of context this is */
273 struct subst cx_subst;
277 #define CXTYPEMASK 0xff
285 /* private flags for CXt_EVAL */
286 #define CXp_REAL 0x00000100 /* truly eval'', not a lookalike */
288 #define CxTYPE(c) ((c)->cx_type & CXTYPEMASK)
289 #define CxREALEVAL(c) (((c)->cx_type & (CXt_EVAL|CXp_REAL)) == (CXt_EVAL|CXp_REAL))
291 #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
296 #define G_VOID 128 /* skip this bit when adding flags below */
298 /* extra flags for Perl_call_* routines */
299 #define G_DISCARD 2 /* Call FREETMPS. */
300 #define G_EVAL 4 /* Assume eval {} around subroutine call. */
301 #define G_NOARGS 8 /* Don't construct a @_ array. */
302 #define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */
303 #define G_NODEBUG 32 /* Disable debugging at toplevel. */
304 #define G_NOCATCH 64 /* Don't do CATCH_SET() */
306 /* flag bits for PL_in_eval */
307 #define EVAL_NULL 0 /* not in an eval */
308 #define EVAL_INEVAL 1 /* some enclosing scope is an eval */
309 #define EVAL_WARNONLY 2 /* used by yywarn() when calling yyerror() */
310 #define EVAL_KEEPERR 4 /* set by Perl_call_sv if G_KEEPERR */
312 /* Support for switching (stack and block) contexts.
313 * This ensures magic doesn't invalidate local stack and cx pointers.
316 #define PERLSI_UNKNOWN -1
317 #define PERLSI_UNDEF 0
318 #define PERLSI_MAIN 1
319 #define PERLSI_MAGIC 2
320 #define PERLSI_SORT 3
321 #define PERLSI_SIGNAL 4
322 #define PERLSI_OVERLOAD 5
323 #define PERLSI_DESTROY 6
324 #define PERLSI_WARNHOOK 7
325 #define PERLSI_DIEHOOK 8
326 #define PERLSI_REQUIRE 9
329 AV * si_stack; /* stack for current runlevel */
330 PERL_CONTEXT * si_cxstack; /* context stack for runlevel */
331 I32 si_cxix; /* current context index */
332 I32 si_cxmax; /* maximum allocated index */
333 I32 si_type; /* type of runlevel */
334 struct stackinfo * si_prev;
335 struct stackinfo * si_next;
336 I32 * si_markbase; /* where markstack begins for us.
337 * currently used only with DEBUGGING,
338 * but not #ifdef-ed for bincompat */
341 typedef struct stackinfo PERL_SI;
343 #define cxstack (PL_curstackinfo->si_cxstack)
344 #define cxstack_ix (PL_curstackinfo->si_cxix)
345 #define cxstack_max (PL_curstackinfo->si_cxmax)
348 # define SET_MARKBASE PL_curstackinfo->si_markbase = PL_markstack_ptr
350 # define SET_MARKBASE NOOP
353 #define PUSHSTACKi(type) \
355 PERL_SI *next = PL_curstackinfo->si_next; \
357 next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \
358 next->si_prev = PL_curstackinfo; \
359 PL_curstackinfo->si_next = next; \
361 next->si_type = type; \
362 next->si_cxix = -1; \
363 AvFILLp(next->si_stack) = 0; \
364 SWITCHSTACK(PL_curstack,next->si_stack); \
365 PL_curstackinfo = next; \
369 #define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)
371 /* POPSTACK works with PL_stack_sp, so it may need to be bracketed by
372 * PUTBACK/SPAGAIN to flush/refresh any local SP that may be active */
376 PERL_SI *prev = PL_curstackinfo->si_prev; \
378 PerlIO_printf(PerlIO_stderr(), "panic: POPSTACK\n"); \
381 SWITCHSTACK(PL_curstack,prev->si_stack); \
382 /* don't free prev here, free them all at the END{} */ \
383 PL_curstackinfo = prev; \
386 #define POPSTACK_TO(s) \
388 while (PL_curstack != s) { \