perl5.git.perl.org Git - perl5.git/blame_incremental

... / ...

Commit	Line	Data
	1	/* cop.h
	2	*
	3	* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
	4	* 2000, 2001, 2002, 2003, 2004, 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	struct cop {
	17	BASEOP
	18	char * cop_label; /* label for this construct */
	19	#ifdef USE_ITHREADS
	20	char * cop_stashpv; /* package line was compiled in */
	21	char * cop_file; /* file name the following line # is from */
	22	#else
	23	HV * cop_stash; /* package line was compiled in */
	24	GV * cop_filegv; /* file the following line # is from */
	25	#endif
	26	U32 cop_seq; /* parse sequence number */
	27	I32 cop_arybase; /* array base this line was compiled with */
	28	line_t cop_line; /* line # of this command */
	29	SV * cop_warnings; /* lexical warnings bitmask */
	30	SV * cop_io; /* lexical IO defaults */
	31	};
	32
	33	#define Nullcop Null(COP*)
	34
	35	#ifdef USE_ITHREADS
	36	# define CopFILE(c) ((c)->cop_file)
	37	# define CopFILEGV(c) (CopFILE(c) \
	38	? gv_fetchfile(CopFILE(c)) : Nullgv)
	39
	40	# ifdef NETWARE
	41	# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
	42	# else
	43	# define CopFILE_set(c,pv) ((c)->cop_file = savesharedpv(pv))
	44	# endif
	45
	46	# define CopFILESV(c) (CopFILE(c) \
	47	? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
	48	# define CopFILEAV(c) (CopFILE(c) \
	49	? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
	50	# define CopSTASHPV(c) ((c)->cop_stashpv)
	51
	52	# ifdef NETWARE
	53	# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
	54	# else
	55	# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savesharedpv(pv))
	56	# endif
	57
	58	# define CopSTASH(c) (CopSTASHPV(c) \
	59	? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
	60	# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
	61	# define CopSTASH_eq(c,hv) ((hv) \
	62	&& (CopSTASHPV(c) == HvNAME(hv) \
	63	\|\| (CopSTASHPV(c) && HvNAME(hv) \
	64	&& strEQ(CopSTASHPV(c), HvNAME(hv)))))
	65	# ifdef NETWARE
	66	# define CopSTASH_free(c) SAVECOPSTASH_FREE(c)
	67	# else
	68	# define CopSTASH_free(c) PerlMemShared_free(CopSTASHPV(c))
	69	# endif
	70
	71	# ifdef NETWARE
	72	# define CopFILE_free(c) SAVECOPFILE_FREE(c)
	73	# else
	74	# define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = Nullch))
	75	# endif
	76	#else
	77	# define CopFILEGV(c) ((c)->cop_filegv)
	78	# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
	79	# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
	80	# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
	81	# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
	82	# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
	83	# define CopSTASH(c) ((c)->cop_stash)
	84	# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
	85	# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
	86	/* cop_stash is not refcounted */
	87	# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
	88	# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
	89	# define CopSTASH_free(c)
	90	# define CopFILE_free(c) (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = Nullgv))
	91
	92	#endif /* USE_ITHREADS */
	93
	94	#define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv))
	95	#define CopLINE(c) ((c)->cop_line)
	96	#define CopLINE_inc(c) (++CopLINE(c))
	97	#define CopLINE_dec(c) (--CopLINE(c))
	98	#define CopLINE_set(c,l) (CopLINE(c) = (l))
	99
	100	/* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */
	101	#ifdef MACOS_TRADITIONAL
	102	# define OutCopFILE(c) MacPerl_MPWFileName(CopFILE(c))
	103	#else
	104	# define OutCopFILE(c) CopFILE(c)
	105	#endif
	106
	107	/*
	108	* Here we have some enormously heavy (or at least ponderous) wizardry.
	109	*/
	110
	111	/* subroutine context */
	112	struct block_sub {
	113	CV * cv;
	114	GV * gv;
	115	GV * dfoutgv;
	116	AV * savearray;
	117	AV * argarray;
	118	long olddepth;
	119	U8 hasargs;
	120	U8 lval; /* XXX merge lval and hasargs? */
	121	PAD *oldcomppad;
	122	OP * retop; /* op to execute on exit from sub */
	123	};
	124
	125	/* base for the next two macros. Don't use directly.
	126	* Note that the refcnt of the cv is incremented twice; The CX one is
	127	* decremented by LEAVESUB, the other by LEAVE. */
	128
	129	#define PUSHSUB_BASE(cx) \
	130	cx->blk_sub.cv = cv; \
	131	cx->blk_sub.olddepth = CvDEPTH(cv); \
	132	cx->blk_sub.hasargs = hasargs; \
	133	cx->blk_sub.retop = Nullop; \
	134	if (!CvDEPTH(cv)) { \
	135	(void)SvREFCNT_inc(cv); \
	136	(void)SvREFCNT_inc(cv); \
	137	SAVEFREESV(cv); \
	138	}
	139
	140
	141	#define PUSHSUB(cx) \
	142	PUSHSUB_BASE(cx) \
	143	cx->blk_sub.lval = PL_op->op_private & \
	144	(OPpLVAL_INTRO\|OPpENTERSUB_INARGS);
	145
	146	/* variant for use by OP_DBSTATE, where op_private holds hint bits */
	147	#define PUSHSUB_DB(cx) \
	148	PUSHSUB_BASE(cx) \
	149	cx->blk_sub.lval = 0;
	150
	151
	152	#define PUSHFORMAT(cx) \
	153	cx->blk_sub.cv = cv; \
	154	cx->blk_sub.gv = gv; \
	155	cx->blk_sub.retop = Nullop; \
	156	cx->blk_sub.hasargs = 0; \
	157	cx->blk_sub.dfoutgv = PL_defoutgv; \
	158	(void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
	159
	160	#define POP_SAVEARRAY() \
	161	STMT_START { \
	162	SvREFCNT_dec(GvAV(PL_defgv)); \
	163	GvAV(PL_defgv) = cx->blk_sub.savearray; \
	164	} STMT_END
	165
	166	/* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't
	167	* leave any (a fast av_clear(ary), basically) */
	168	#define CLEAR_ARGARRAY(ary) \
	169	STMT_START { \
	170	AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary); \
	171	SvPVX(ary) = (char*)AvALLOC(ary); \
	172	AvFILLp(ary) = -1; \
	173	} STMT_END
	174
	175	#define POPSUB(cx,sv) \
	176	STMT_START { \
	177	if (cx->blk_sub.hasargs) { \
	178	POP_SAVEARRAY(); \
	179	/* abandon @_ if it got reified */ \
	180	if (AvREAL(cx->blk_sub.argarray)) { \
	181	SSize_t fill = AvFILLp(cx->blk_sub.argarray); \
	182	SvREFCNT_dec(cx->blk_sub.argarray); \
	183	cx->blk_sub.argarray = newAV(); \
	184	av_extend(cx->blk_sub.argarray, fill); \
	185	AvFLAGS(cx->blk_sub.argarray) = AVf_REIFY; \
	186	CX_CURPAD_SV(cx->blk_sub, 0) = (SV*)cx->blk_sub.argarray; \
	187	} \
	188	else { \
	189	CLEAR_ARGARRAY(cx->blk_sub.argarray); \
	190	} \
	191	} \
	192	sv = (SV*)cx->blk_sub.cv; \
	193	if (sv && (CvDEPTH((CV*)sv) = cx->blk_sub.olddepth)) \
	194	sv = Nullsv; \
	195	} STMT_END
	196
	197	#define LEAVESUB(sv) \
	198	STMT_START { \
	199	if (sv) \
	200	SvREFCNT_dec(sv); \
	201	} STMT_END
	202
	203	#define POPFORMAT(cx) \
	204	setdefout(cx->blk_sub.dfoutgv); \
	205	SvREFCNT_dec(cx->blk_sub.dfoutgv);
	206
	207	/* eval context */
	208	struct block_eval {
	209	I32 old_in_eval;
	210	I32 old_op_type;
	211	SV * old_namesv;
	212	OP * old_eval_root;
	213	SV * cur_text;
	214	CV * cv;
	215	OP * retop; /* op to execute on exit from eval */
	216	};
	217
	218	#define PUSHEVAL(cx,n,fgv) \
	219	STMT_START { \
	220	cx->blk_eval.old_in_eval = PL_in_eval; \
	221	cx->blk_eval.old_op_type = PL_op->op_type; \
	222	cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : Nullsv); \
	223	cx->blk_eval.old_eval_root = PL_eval_root; \
	224	cx->blk_eval.cur_text = PL_linestr; \
	225	cx->blk_eval.cv = Nullcv; /* set by doeval(), as applicable */ \
	226	cx->blk_eval.retop = Nullop; \
	227	} STMT_END
	228
	229	#define POPEVAL(cx) \
	230	STMT_START { \
	231	PL_in_eval = cx->blk_eval.old_in_eval; \
	232	optype = cx->blk_eval.old_op_type; \
	233	PL_eval_root = cx->blk_eval.old_eval_root; \
	234	if (cx->blk_eval.old_namesv) \
	235	sv_2mortal(cx->blk_eval.old_namesv); \
	236	} STMT_END
	237
	238	/* loop context */
	239	struct block_loop {
	240	char * label;
	241	I32 resetsp;
	242	OP * redo_op;
	243	OP * next_op;
	244	OP * last_op;
	245	#ifdef USE_ITHREADS
	246	void * iterdata;
	247	PAD *oldcomppad;
	248	#else
	249	SV ** itervar;
	250	#endif
	251	SV * itersave;
	252	SV * iterlval;
	253	AV * iterary;
	254	IV iterix;
	255	IV itermax;
	256	};
	257
	258	#ifdef USE_ITHREADS
	259	# define CxITERVAR(c) \
	260	((c)->blk_loop.iterdata \
	261	? (CxPADLOOP(cx) \
	262	? &CX_CURPAD_SV( (c)->blk_loop, \
	263	INT2PTR(PADOFFSET, (c)->blk_loop.iterdata)) \
	264	: &GvSV((GV*)(c)->blk_loop.iterdata)) \
	265	: (SV**)NULL)
	266	# define CX_ITERDATA_SET(cx,idata) \
	267	CX_CURPAD_SAVE(cx->blk_loop); \
	268	if ((cx->blk_loop.iterdata = (idata))) \
	269	cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx)); \
	270	else \
	271	cx->blk_loop.itersave = Nullsv;
	272	#else
	273	# define CxITERVAR(c) ((c)->blk_loop.itervar)
	274	# define CX_ITERDATA_SET(cx,ivar) \
	275	if ((cx->blk_loop.itervar = (SV**)(ivar))) \
	276	cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx)); \
	277	else \
	278	cx->blk_loop.itersave = Nullsv;
	279	#endif
	280
	281	#define PUSHLOOP(cx, dat, s) \
	282	cx->blk_loop.label = PL_curcop->cop_label; \
	283	cx->blk_loop.resetsp = s - PL_stack_base; \
	284	cx->blk_loop.redo_op = cLOOP->op_redoop; \
	285	cx->blk_loop.next_op = cLOOP->op_nextop; \
	286	cx->blk_loop.last_op = cLOOP->op_lastop; \
	287	cx->blk_loop.iterlval = Nullsv; \
	288	cx->blk_loop.iterary = Nullav; \
	289	cx->blk_loop.iterix = -1; \
	290	CX_ITERDATA_SET(cx,dat);
	291
	292	#define POPLOOP(cx) \
	293	SvREFCNT_dec(cx->blk_loop.iterlval); \
	294	if (CxITERVAR(cx)) { \
	295	SV **s_v_p = CxITERVAR(cx); \
	296	sv_2mortal(*s_v_p); \
	297	*s_v_p = cx->blk_loop.itersave; \
	298	} \
	299	if (cx->blk_loop.iterary && cx->blk_loop.iterary != PL_curstack)\
	300	SvREFCNT_dec(cx->blk_loop.iterary);
	301
	302	/* context common to subroutines, evals and loops */
	303	struct block {
	304	I32 blku_oldsp; /* stack pointer to copy stuff down to */
	305	COP * blku_oldcop; /* old curcop pointer */
	306	I32 blku_oldmarksp; /* mark stack index */
	307	I32 blku_oldscopesp; /* scope stack index */
	308	PMOP * blku_oldpm; /* values of pattern match vars */
	309	U8 blku_gimme; /* is this block running in list context? */
	310
	311	union {
	312	struct block_sub blku_sub;
	313	struct block_eval blku_eval;
	314	struct block_loop blku_loop;
	315	} blk_u;
	316	};
	317	#define blk_oldsp cx_u.cx_blk.blku_oldsp
	318	#define blk_oldcop cx_u.cx_blk.blku_oldcop
	319	#define blk_oldmarksp cx_u.cx_blk.blku_oldmarksp
	320	#define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp
	321	#define blk_oldpm cx_u.cx_blk.blku_oldpm
	322	#define blk_gimme cx_u.cx_blk.blku_gimme
	323	#define blk_sub cx_u.cx_blk.blk_u.blku_sub
	324	#define blk_eval cx_u.cx_blk.blk_u.blku_eval
	325	#define blk_loop cx_u.cx_blk.blk_u.blku_loop
	326
	327	/* Enter a block. */
	328	#define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \
	329	cx->cx_type = t, \
	330	cx->blk_oldsp = sp - PL_stack_base, \
	331	cx->blk_oldcop = PL_curcop, \
	332	cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \
	333	cx->blk_oldscopesp = PL_scopestack_ix, \
	334	cx->blk_oldpm = PL_curpm, \
	335	cx->blk_gimme = (U8)gimme; \
	336	DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n", \
	337	(long)cxstack_ix, PL_block_type[CxTYPE(cx)]); )
	338
	339	/* Exit a block (RETURN and LAST). */
	340	#define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \
	341	newsp = PL_stack_base + cx->blk_oldsp, \
	342	PL_curcop = cx->blk_oldcop, \
	343	PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
	344	PL_scopestack_ix = cx->blk_oldscopesp, \
	345	pm = cx->blk_oldpm, \
	346	gimme = cx->blk_gimme; \
	347	DEBUG_SCOPE("POPBLOCK"); \
	348	DEBUG_l( PerlIO_printf(Perl_debug_log, "Leaving block %ld, type %s\n", \
	349	(long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); )
	350
	351	/* Continue a block elsewhere (NEXT and REDO). */
	352	#define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \
	353	PL_stack_sp = PL_stack_base + cx->blk_oldsp, \
	354	PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \
	355	PL_scopestack_ix = cx->blk_oldscopesp, \
	356	PL_curpm = cx->blk_oldpm; \
	357	DEBUG_SCOPE("TOPBLOCK");
	358
	359	/* substitution context */
	360	struct subst {
	361	I32 sbu_iters;
	362	I32 sbu_maxiters;
	363	I32 sbu_rflags;
	364	I32 sbu_oldsave;
	365	bool sbu_once;
	366	bool sbu_rxtainted;
	367	char * sbu_orig;
	368	SV * sbu_dstr;
	369	SV * sbu_targ;
	370	char * sbu_s;
	371	char * sbu_m;
	372	char * sbu_strend;
	373	void * sbu_rxres;
	374	REGEXP * sbu_rx;
	375	};
	376	#define sb_iters cx_u.cx_subst.sbu_iters
	377	#define sb_maxiters cx_u.cx_subst.sbu_maxiters
	378	#define sb_rflags cx_u.cx_subst.sbu_rflags
	379	#define sb_oldsave cx_u.cx_subst.sbu_oldsave
	380	#define sb_once cx_u.cx_subst.sbu_once
	381	#define sb_rxtainted cx_u.cx_subst.sbu_rxtainted
	382	#define sb_orig cx_u.cx_subst.sbu_orig
	383	#define sb_dstr cx_u.cx_subst.sbu_dstr
	384	#define sb_targ cx_u.cx_subst.sbu_targ
	385	#define sb_s cx_u.cx_subst.sbu_s
	386	#define sb_m cx_u.cx_subst.sbu_m
	387	#define sb_strend cx_u.cx_subst.sbu_strend
	388	#define sb_rxres cx_u.cx_subst.sbu_rxres
	389	#define sb_rx cx_u.cx_subst.sbu_rx
	390
	391	#define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \
	392	cx->sb_iters = iters, \
	393	cx->sb_maxiters = maxiters, \
	394	cx->sb_rflags = r_flags, \
	395	cx->sb_oldsave = oldsave, \
	396	cx->sb_once = once, \
	397	cx->sb_rxtainted = rxtainted, \
	398	cx->sb_orig = orig, \
	399	cx->sb_dstr = dstr, \
	400	cx->sb_targ = targ, \
	401	cx->sb_s = s, \
	402	cx->sb_m = m, \
	403	cx->sb_strend = strend, \
	404	cx->sb_rxres = Null(void*), \
	405	cx->sb_rx = rx, \
	406	cx->cx_type = CXt_SUBST; \
	407	rxres_save(&cx->sb_rxres, rx)
	408
	409	#define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \
	410	rxres_free(&cx->sb_rxres)
	411
	412	struct context {
	413	U32 cx_type; /* what kind of context this is */
	414	union {
	415	struct block cx_blk;
	416	struct subst cx_subst;
	417	} cx_u;
	418	};
	419
	420	#define CXTYPEMASK 0xff
	421	#define CXt_NULL 0
	422	#define CXt_SUB 1
	423	#define CXt_EVAL 2
	424	#define CXt_LOOP 3
	425	#define CXt_SUBST 4
	426	#define CXt_BLOCK 5
	427	#define CXt_FORMAT 6
	428
	429	/* private flags for CXt_EVAL */
	430	#define CXp_REAL 0x00000100 /* truly eval'', not a lookalike */
	431	#define CXp_TRYBLOCK 0x00000200 /* eval{}, not eval'' or similar */
	432
	433	#ifdef USE_ITHREADS
	434	/* private flags for CXt_LOOP */
	435	# define CXp_PADVAR 0x00000100 /* itervar lives on pad, iterdata
	436	has pad offset; if not set,
	437	iterdata holds GV* */
	438	# define CxPADLOOP(c) (((c)->cx_type & (CXt_LOOP\|CXp_PADVAR)) \
	439	== (CXt_LOOP\|CXp_PADVAR))
	440	#endif
	441
	442	#define CxTYPE(c) ((c)->cx_type & CXTYPEMASK)
	443	#define CxREALEVAL(c) (((c)->cx_type & (CXt_EVAL\|CXp_REAL)) \
	444	== (CXt_EVAL\|CXp_REAL))
	445	#define CxTRYBLOCK(c) (((c)->cx_type & (CXt_EVAL\|CXp_TRYBLOCK)) \
	446	== (CXt_EVAL\|CXp_TRYBLOCK))
	447
	448	#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
	449
	450	/*
	451	=head1 "Gimme" Values
	452	*/
	453
	454	/*
	455	=for apidoc AmU\|\|G_SCALAR
	456	Used to indicate scalar context. See C<GIMME_V>, C<GIMME>, and
	457	L<perlcall>.
	458
	459	=for apidoc AmU\|\|G_ARRAY
	460	Used to indicate list context. See C<GIMME_V>, C<GIMME> and
	461	L<perlcall>.
	462
	463	=for apidoc AmU\|\|G_VOID
	464	Used to indicate void context. See C<GIMME_V> and L<perlcall>.
	465
	466	=for apidoc AmU\|\|G_DISCARD
	467	Indicates that arguments returned from a callback should be discarded. See
	468	L<perlcall>.
	469
	470	=for apidoc AmU\|\|G_EVAL
	471
	472	Used to force a Perl C<eval> wrapper around a callback. See
	473	L<perlcall>.
	474
	475	=for apidoc AmU\|\|G_NOARGS
	476
	477	Indicates that no arguments are being sent to a callback. See
	478	L<perlcall>.
	479
	480	=cut
	481	*/
	482
	483	#define G_SCALAR 0
	484	#define G_ARRAY 1
	485	#define G_VOID 128 /* skip this bit when adding flags below */
	486
	487	/* extra flags for Perl_call_* routines */
	488	#define G_DISCARD 2 /* Call FREETMPS. */
	489	#define G_EVAL 4 /* Assume eval {} around subroutine call. */
	490	#define G_NOARGS 8 /* Don't construct a @_ array. */
	491	#define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */
	492	#define G_NODEBUG 32 /* Disable debugging at toplevel. */
	493	#define G_METHOD 64 /* Calling method. */
	494
	495	/* flag bits for PL_in_eval */
	496	#define EVAL_NULL 0 /* not in an eval */
	497	#define EVAL_INEVAL 1 /* some enclosing scope is an eval */
	498	#define EVAL_WARNONLY 2 /* used by yywarn() when calling yyerror() */
	499	#define EVAL_KEEPERR 4 /* set by Perl_call_sv if G_KEEPERR */
	500	#define EVAL_INREQUIRE 8 /* The code is being required. */
	501
	502	/* Support for switching (stack and block) contexts.
	503	* This ensures magic doesn't invalidate local stack and cx pointers.
	504	*/
	505
	506	#define PERLSI_UNKNOWN -1
	507	#define PERLSI_UNDEF 0
	508	#define PERLSI_MAIN 1
	509	#define PERLSI_MAGIC 2
	510	#define PERLSI_SORT 3
	511	#define PERLSI_SIGNAL 4
	512	#define PERLSI_OVERLOAD 5
	513	#define PERLSI_DESTROY 6
	514	#define PERLSI_WARNHOOK 7
	515	#define PERLSI_DIEHOOK 8
	516	#define PERLSI_REQUIRE 9
	517
	518	struct stackinfo {
	519	AV * si_stack; /* stack for current runlevel */
	520	PERL_CONTEXT * si_cxstack; /* context stack for runlevel */
	521	I32 si_cxix; /* current context index */
	522	I32 si_cxmax; /* maximum allocated index */
	523	I32 si_type; /* type of runlevel */
	524	struct stackinfo * si_prev;
	525	struct stackinfo * si_next;
	526	I32 si_markoff; /* offset where markstack begins for us.
	527	* currently used only with DEBUGGING,
	528	* but not #ifdef-ed for bincompat */
	529	};
	530
	531	typedef struct stackinfo PERL_SI;
	532
	533	#define cxstack (PL_curstackinfo->si_cxstack)
	534	#define cxstack_ix (PL_curstackinfo->si_cxix)
	535	#define cxstack_max (PL_curstackinfo->si_cxmax)
	536
	537	#ifdef DEBUGGING
	538	# define SET_MARK_OFFSET \
	539	PL_curstackinfo->si_markoff = PL_markstack_ptr - PL_markstack
	540	#else
	541	# define SET_MARK_OFFSET NOOP
	542	#endif
	543
	544	#define PUSHSTACKi(type) \
	545	STMT_START { \
	546	PERL_SI *next = PL_curstackinfo->si_next; \
	547	if (!next) { \
	548	next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \
	549	next->si_prev = PL_curstackinfo; \
	550	PL_curstackinfo->si_next = next; \
	551	} \
	552	next->si_type = type; \
	553	next->si_cxix = -1; \
	554	AvFILLp(next->si_stack) = 0; \
	555	SWITCHSTACK(PL_curstack,next->si_stack); \
	556	PL_curstackinfo = next; \
	557	SET_MARK_OFFSET; \
	558	} STMT_END
	559
	560	#define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)
	561
	562	/* POPSTACK works with PL_stack_sp, so it may need to be bracketed by
	563	* PUTBACK/SPAGAIN to flush/refresh any local SP that may be active */
	564	#define POPSTACK \
	565	STMT_START { \
	566	dSP; \
	567	PERL_SI *prev = PL_curstackinfo->si_prev; \
	568	if (!prev) { \
	569	PerlIO_printf(Perl_error_log, "panic: POPSTACK\n"); \
	570	my_exit(1); \
	571	} \
	572	SWITCHSTACK(PL_curstack,prev->si_stack); \
	573	/* don't free prev here, free them all at the END{} */ \
	574	PL_curstackinfo = prev; \
	575	} STMT_END
	576
	577	#define POPSTACK_TO(s) \
	578	STMT_START { \
	579	while (PL_curstack != s) { \
	580	dounwind(-1); \
	581	POPSTACK; \
	582	} \
	583	} STMT_END
	584
	585	#define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
	586	#define IN_PERL_RUNTIME (PL_curcop != &PL_compiling)
	587