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); \
81 if (!(CvDEPTH(cxsub.cv) = cxsub.olddepth)) \
82 SvREFCNT_dec(cxsub.cv); \
85 #define POPFORMAT(cx) \
86 setdefout(cx->blk_sub.dfoutgv); \
87 SvREFCNT_dec(cx->blk_sub.dfoutgv);
98 #define PUSHEVAL(cx,n,fgv) \
99 cx->blk_eval.old_in_eval = PL_in_eval; \
100 cx->blk_eval.old_op_type = PL_op->op_type; \
101 cx->blk_eval.old_name = n; \
102 cx->blk_eval.old_eval_root = PL_eval_root; \
103 cx->blk_eval.cur_text = PL_linestr;
105 #define POPEVAL(cx) \
106 PL_in_eval = cx->blk_eval.old_in_eval; \
107 optype = cx->blk_eval.old_op_type; \
108 PL_eval_root = cx->blk_eval.old_eval_root;
125 #define PUSHLOOP(cx, ivar, s) \
126 cx->blk_loop.label = PL_curcop->cop_label; \
127 cx->blk_loop.resetsp = s - PL_stack_base; \
128 cx->blk_loop.redo_op = cLOOP->op_redoop; \
129 cx->blk_loop.next_op = cLOOP->op_nextop; \
130 cx->blk_loop.last_op = cLOOP->op_lastop; \
131 if (cx->blk_loop.itervar = (ivar)) \
132 cx->blk_loop.itersave = SvREFCNT_inc(*cx->blk_loop.itervar);\
133 cx->blk_loop.iterlval = Nullsv; \
134 cx->blk_loop.iterary = Nullav; \
135 cx->blk_loop.iterix = -1;
137 #define POPLOOP(cx) \
138 { struct block_loop cxloop; \
142 #define POPLOOP1(cx) \
143 cxloop = cx->blk_loop; /* because DESTROY may clobber *cx */ \
144 newsp = PL_stack_base + cxloop.resetsp;
147 SvREFCNT_dec(cxloop.iterlval); \
148 if (cxloop.itervar) { \
149 sv_2mortal(*cxloop.itervar); \
150 *cxloop.itervar = cxloop.itersave; \
152 if (cxloop.iterary && cxloop.iterary != PL_curstack) \
153 SvREFCNT_dec(cxloop.iterary);
155 /* context common to subroutines, evals and loops */
157 I32 blku_oldsp; /* stack pointer to copy stuff down to */
158 COP * blku_oldcop; /* old curcop pointer */
159 I32 blku_oldretsp; /* return stack index */
160 I32 blku_oldmarksp; /* mark stack index */
161 I32 blku_oldscopesp; /* scope stack index */
162 PMOP * blku_oldpm; /* values of pattern match vars */
163 U8 blku_gimme; /* is this block running in list context? */
166 struct block_sub blku_sub;
167 struct block_eval blku_eval;
168 struct block_loop blku_loop;
171 #define blk_oldsp cx_u.cx_blk.blku_oldsp
172 #define blk_oldcop cx_u.cx_blk.blku_oldcop
173 #define blk_oldretsp cx_u.cx_blk.blku_oldretsp
174 #define blk_oldmarksp cx_u.cx_blk.blku_oldmarksp
175 #define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp
176 #define blk_oldpm cx_u.cx_blk.blku_oldpm
177 #define blk_gimme cx_u.cx_blk.blku_gimme
178 #define blk_sub cx_u.cx_blk.blk_u.blku_sub
179 #define blk_eval cx_u.cx_blk.blk_u.blku_eval
180 #define blk_loop cx_u.cx_blk.blk_u.blku_loop
183 #define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \
185 cx->blk_oldsp = sp - PL_stack_base, \
186 cx->blk_oldcop = PL_curcop, \
187 cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \
188 cx->blk_oldscopesp = PL_scopestack_ix, \
189 cx->blk_oldretsp = PL_retstack_ix, \
190 cx->blk_oldpm = PL_curpm, \
191 cx->blk_gimme = gimme; \
192 DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Entering block %ld, type %s\n", \
193 (long)cxstack_ix, PL_block_type[CxTYPE(cx)]); )
195 /* Exit a block (RETURN and LAST). */
196 #define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \
197 newsp = PL_stack_base + cx->blk_oldsp, \
198 PL_curcop = cx->blk_oldcop, \
199 PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
200 PL_scopestack_ix = cx->blk_oldscopesp, \
201 PL_retstack_ix = cx->blk_oldretsp, \
202 pm = cx->blk_oldpm, \
203 gimme = cx->blk_gimme; \
204 DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Leaving block %ld, type %s\n", \
205 (long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); )
207 /* Continue a block elsewhere (NEXT and REDO). */
208 #define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \
209 PL_stack_sp = PL_stack_base + cx->blk_oldsp, \
210 PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
211 PL_scopestack_ix = cx->blk_oldscopesp, \
212 PL_retstack_ix = cx->blk_oldretsp, \
213 PL_curpm = cx->blk_oldpm
215 /* substitution context */
232 #define sb_iters cx_u.cx_subst.sbu_iters
233 #define sb_maxiters cx_u.cx_subst.sbu_maxiters
234 #define sb_rflags cx_u.cx_subst.sbu_rflags
235 #define sb_oldsave cx_u.cx_subst.sbu_oldsave
236 #define sb_once cx_u.cx_subst.sbu_once
237 #define sb_rxtainted cx_u.cx_subst.sbu_rxtainted
238 #define sb_orig cx_u.cx_subst.sbu_orig
239 #define sb_dstr cx_u.cx_subst.sbu_dstr
240 #define sb_targ cx_u.cx_subst.sbu_targ
241 #define sb_s cx_u.cx_subst.sbu_s
242 #define sb_m cx_u.cx_subst.sbu_m
243 #define sb_strend cx_u.cx_subst.sbu_strend
244 #define sb_rxres cx_u.cx_subst.sbu_rxres
245 #define sb_rx cx_u.cx_subst.sbu_rx
247 #define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \
248 cx->sb_iters = iters, \
249 cx->sb_maxiters = maxiters, \
250 cx->sb_rflags = r_flags, \
251 cx->sb_oldsave = oldsave, \
252 cx->sb_once = once, \
253 cx->sb_rxtainted = rxtainted, \
254 cx->sb_orig = orig, \
255 cx->sb_dstr = dstr, \
256 cx->sb_targ = targ, \
259 cx->sb_strend = strend, \
260 cx->sb_rxres = Null(void*), \
262 cx->cx_type = CXt_SUBST; \
263 rxres_save(&cx->sb_rxres, rx)
265 #define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \
266 rxres_free(&cx->sb_rxres)
269 U32 cx_type; /* what kind of context this is */
272 struct subst cx_subst;
276 #define CXTYPEMASK 0xff
284 /* private flags for CXt_EVAL */
285 #define CXp_REAL 0x00000100 /* truly eval'', not a lookalike */
287 #define CxTYPE(c) ((c)->cx_type & CXTYPEMASK)
288 #define CxREALEVAL(c) (((c)->cx_type & (CXt_EVAL|CXp_REAL)) == (CXt_EVAL|CXp_REAL))
290 #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
295 #define G_VOID 128 /* skip this bit when adding flags below */
297 /* extra flags for Perl_call_* routines */
298 #define G_DISCARD 2 /* Call FREETMPS. */
299 #define G_EVAL 4 /* Assume eval {} around subroutine call. */
300 #define G_NOARGS 8 /* Don't construct a @_ array. */
301 #define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */
302 #define G_NODEBUG 32 /* Disable debugging at toplevel. */
303 #define G_NOCATCH 64 /* Don't do CATCH_SET() */
305 /* flag bits for PL_in_eval */
306 #define EVAL_NULL 0 /* not in an eval */
307 #define EVAL_INEVAL 1 /* some enclosing scope is an eval */
308 #define EVAL_WARNONLY 2 /* used by yywarn() when calling yyerror() */
309 #define EVAL_KEEPERR 4 /* set by Perl_call_sv if G_KEEPERR */
311 /* Support for switching (stack and block) contexts.
312 * This ensures magic doesn't invalidate local stack and cx pointers.
315 #define PERLSI_UNKNOWN -1
316 #define PERLSI_UNDEF 0
317 #define PERLSI_MAIN 1
318 #define PERLSI_MAGIC 2
319 #define PERLSI_SORT 3
320 #define PERLSI_SIGNAL 4
321 #define PERLSI_OVERLOAD 5
322 #define PERLSI_DESTROY 6
323 #define PERLSI_WARNHOOK 7
324 #define PERLSI_DIEHOOK 8
325 #define PERLSI_REQUIRE 9
328 AV * si_stack; /* stack for current runlevel */
329 PERL_CONTEXT * si_cxstack; /* context stack for runlevel */
330 I32 si_cxix; /* current context index */
331 I32 si_cxmax; /* maximum allocated index */
332 I32 si_type; /* type of runlevel */
333 struct stackinfo * si_prev;
334 struct stackinfo * si_next;
335 I32 * si_markbase; /* where markstack begins for us.
336 * currently used only with DEBUGGING,
337 * but not #ifdef-ed for bincompat */
340 typedef struct stackinfo PERL_SI;
342 #define cxstack (PL_curstackinfo->si_cxstack)
343 #define cxstack_ix (PL_curstackinfo->si_cxix)
344 #define cxstack_max (PL_curstackinfo->si_cxmax)
347 # define SET_MARKBASE PL_curstackinfo->si_markbase = PL_markstack_ptr
349 # define SET_MARKBASE NOOP
352 #define PUSHSTACKi(type) \
354 PERL_SI *next = PL_curstackinfo->si_next; \
356 next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \
357 next->si_prev = PL_curstackinfo; \
358 PL_curstackinfo->si_next = next; \
360 next->si_type = type; \
361 next->si_cxix = -1; \
362 AvFILLp(next->si_stack) = 0; \
363 SWITCHSTACK(PL_curstack,next->si_stack); \
364 PL_curstackinfo = next; \
368 #define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)
370 /* POPSTACK works with PL_stack_sp, so it may need to be bracketed by
371 * PUTBACK/SPAGAIN to flush/refresh any local SP that may be active */
375 PERL_SI *prev = PL_curstackinfo->si_prev; \
377 PerlIO_printf(PerlIO_stderr(), "panic: POPSTACK\n"); \
380 SWITCHSTACK(PL_curstack,prev->si_stack); \
381 /* don't free prev here, free them all at the END{} */ \
382 PL_curstackinfo = prev; \
385 #define POPSTACK_TO(s) \
387 while (PL_curstack != s) { \