This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
obstruct pod2man doc tweaks
[perl5.git] / cop.h
CommitLineData
a0d0e21e 1/* cop.h
79072805 2 *
a0d0e21e 3 * Copyright (c) 1991-1994, Larry Wall
79072805
LW
4 *
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.
7 *
79072805
LW
8 */
9
79072805
LW
10struct cop {
11 BASEOP
a0d0e21e 12 char * cop_label; /* label for this construct */
79072805
LW
13 HV * cop_stash; /* package line was compiled in */
14 GV * cop_filegv; /* file the following line # is from */
a0d0e21e
LW
15 U32 cop_seq; /* parse sequence number */
16 I32 cop_arybase; /* array base this line was compiled with */
79072805 17 line_t cop_line; /* line # of this command */
79072805
LW
18};
19
20#define Nullcop Null(COP*)
21
22/*
23 * Here we have some enormously heavy (or at least ponderous) wizardry.
24 */
25
26/* subroutine context */
27struct block_sub {
28 CV * cv;
29 GV * gv;
463ee0b2 30 GV * dfoutgv;
79072805
LW
31 AV * savearray;
32 AV * argarray;
33 U16 olddepth;
34 U8 hasargs;
35};
36
37#define PUSHSUB(cx) \
38 cx->blk_sub.cv = cv; \
79072805
LW
39 cx->blk_sub.olddepth = CvDEPTH(cv); \
40 cx->blk_sub.hasargs = hasargs;
41
42#define PUSHFORMAT(cx) \
43 cx->blk_sub.cv = cv; \
44 cx->blk_sub.gv = gv; \
4633a7c4 45 cx->blk_sub.hasargs = 0; \
463ee0b2 46 cx->blk_sub.dfoutgv = defoutgv; \
4633a7c4 47 (void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
79072805
LW
48
49#define POPSUB(cx) \
50 if (cx->blk_sub.hasargs) { /* put back old @_ */ \
79072805
LW
51 GvAV(defgv) = cx->blk_sub.savearray; \
52 } \
8990e307
LW
53 if (cx->blk_sub.cv) { \
54 if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) { \
03d5e78e
PP
55 if (cx->blk_sub.hasargs) { \
56 SvREFCNT_inc((SV*)cx->blk_sub.argarray); \
57 } \
a0d0e21e 58 SvREFCNT_dec((SV*)cx->blk_sub.cv); \
8990e307 59 } \
79072805
LW
60 }
61
62#define POPFORMAT(cx) \
4633a7c4
LW
63 setdefout(cx->blk_sub.dfoutgv); \
64 SvREFCNT_dec(cx->blk_sub.dfoutgv);
79072805
LW
65
66/* eval context */
67struct block_eval {
68 I32 old_in_eval;
69 I32 old_op_type;
70 char * old_name;
71 OP * old_eval_root;
748a9306 72 SV * cur_text;
79072805
LW
73};
74
8990e307 75#define PUSHEVAL(cx,n,fgv) \
79072805
LW
76 cx->blk_eval.old_in_eval = in_eval; \
77 cx->blk_eval.old_op_type = op->op_type; \
78 cx->blk_eval.old_name = n; \
748a9306
LW
79 cx->blk_eval.old_eval_root = eval_root; \
80 cx->blk_eval.cur_text = linestr;
79072805
LW
81
82#define POPEVAL(cx) \
83 in_eval = cx->blk_eval.old_in_eval; \
84 optype = cx->blk_eval.old_op_type; \
85 eval_root = cx->blk_eval.old_eval_root;
86
87/* loop context */
88struct block_loop {
89 char * label;
90 I32 resetsp;
91 OP * redo_op;
92 OP * next_op;
93 OP * last_op;
94 SV ** itervar;
95 SV * itersave;
5f05dabc 96 SV * iterlval;
79072805
LW
97 AV * iterary;
98 I32 iterix;
99};
100
101#define PUSHLOOP(cx, ivar, s) \
102 cx->blk_loop.label = curcop->cop_label; \
103 cx->blk_loop.resetsp = s - stack_base; \
104 cx->blk_loop.redo_op = cLOOP->op_redoop; \
105 cx->blk_loop.next_op = cLOOP->op_nextop; \
106 cx->blk_loop.last_op = cLOOP->op_lastop; \
5f05dabc 107 cx->blk_loop.iterlval = Nullsv; \
79072805
LW
108 cx->blk_loop.itervar = ivar; \
109 if (ivar) \
110 cx->blk_loop.itersave = *cx->blk_loop.itervar;
111
112#define POPLOOP(cx) \
5f05dabc
PP
113 newsp = stack_base + cx->blk_loop.resetsp; \
114 SvREFCNT_dec(cx->blk_loop.iterlval)
79072805
LW
115
116/* context common to subroutines, evals and loops */
117struct block {
118 I32 blku_oldsp; /* stack pointer to copy stuff down to */
119 COP * blku_oldcop; /* old curcop pointer */
120 I32 blku_oldretsp; /* return stack index */
121 I32 blku_oldmarksp; /* mark stack index */
122 I32 blku_oldscopesp; /* scope stack index */
123 PMOP * blku_oldpm; /* values of pattern match vars */
124 U8 blku_gimme; /* is this block running in list context? */
125
126 union {
127 struct block_sub blku_sub;
128 struct block_eval blku_eval;
129 struct block_loop blku_loop;
130 } blk_u;
131};
132#define blk_oldsp cx_u.cx_blk.blku_oldsp
133#define blk_oldcop cx_u.cx_blk.blku_oldcop
134#define blk_oldretsp cx_u.cx_blk.blku_oldretsp
135#define blk_oldmarksp cx_u.cx_blk.blku_oldmarksp
136#define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp
137#define blk_oldpm cx_u.cx_blk.blku_oldpm
138#define blk_gimme cx_u.cx_blk.blku_gimme
139#define blk_sub cx_u.cx_blk.blk_u.blku_sub
140#define blk_eval cx_u.cx_blk.blk_u.blku_eval
141#define blk_loop cx_u.cx_blk.blk_u.blku_loop
142
143/* Enter a block. */
8990e307 144#define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \
79072805 145 cx->cx_type = t, \
8990e307 146 cx->blk_oldsp = sp - stack_base, \
79072805
LW
147 cx->blk_oldcop = curcop, \
148 cx->blk_oldmarksp = markstack_ptr - markstack, \
149 cx->blk_oldscopesp = scopestack_ix, \
150 cx->blk_oldretsp = retstack_ix, \
151 cx->blk_oldpm = curpm, \
152 cx->blk_gimme = gimme; \
760ac839 153 DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Entering block %ld, type %s\n", \
a0d0e21e 154 (long)cxstack_ix, block_type[t]); )
79072805
LW
155
156/* Exit a block (RETURN and LAST). */
a0d0e21e 157#define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \
79072805
LW
158 newsp = stack_base + cx->blk_oldsp, \
159 curcop = cx->blk_oldcop, \
160 markstack_ptr = markstack + cx->blk_oldmarksp, \
161 scopestack_ix = cx->blk_oldscopesp, \
162 retstack_ix = cx->blk_oldretsp, \
a0d0e21e 163 pm = cx->blk_oldpm, \
79072805 164 gimme = cx->blk_gimme; \
760ac839 165 DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Leaving block %ld, type %s\n", \
a0d0e21e 166 (long)cxstack_ix+1,block_type[cx->cx_type]); )
79072805
LW
167
168/* Continue a block elsewhere (NEXT and REDO). */
169#define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \
170 stack_sp = stack_base + cx->blk_oldsp, \
171 markstack_ptr = markstack + cx->blk_oldmarksp, \
172 scopestack_ix = cx->blk_oldscopesp, \
173 retstack_ix = cx->blk_oldretsp
174
175/* substitution context */
176struct subst {
177 I32 sbu_iters;
178 I32 sbu_maxiters;
179 I32 sbu_safebase;
180 I32 sbu_once;
4633a7c4 181 I32 sbu_oldsave;
79072805
LW
182 char * sbu_orig;
183 SV * sbu_dstr;
184 SV * sbu_targ;
185 char * sbu_s;
186 char * sbu_m;
187 char * sbu_strend;
188 char * sbu_subbase;
c07a80fd 189 REGEXP * sbu_rx;
79072805
LW
190};
191#define sb_iters cx_u.cx_subst.sbu_iters
192#define sb_maxiters cx_u.cx_subst.sbu_maxiters
193#define sb_safebase cx_u.cx_subst.sbu_safebase
194#define sb_once cx_u.cx_subst.sbu_once
4633a7c4 195#define sb_oldsave cx_u.cx_subst.sbu_oldsave
79072805
LW
196#define sb_orig cx_u.cx_subst.sbu_orig
197#define sb_dstr cx_u.cx_subst.sbu_dstr
198#define sb_targ cx_u.cx_subst.sbu_targ
199#define sb_s cx_u.cx_subst.sbu_s
200#define sb_m cx_u.cx_subst.sbu_m
201#define sb_strend cx_u.cx_subst.sbu_strend
202#define sb_subbase cx_u.cx_subst.sbu_subbase
c07a80fd 203#define sb_rx cx_u.cx_subst.sbu_rx
79072805
LW
204
205#define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \
206 cx->sb_iters = iters, \
207 cx->sb_maxiters = maxiters, \
208 cx->sb_safebase = safebase, \
209 cx->sb_once = once, \
4633a7c4 210 cx->sb_oldsave = oldsave, \
79072805
LW
211 cx->sb_orig = orig, \
212 cx->sb_dstr = dstr, \
213 cx->sb_targ = targ, \
214 cx->sb_s = s, \
215 cx->sb_m = m, \
216 cx->sb_strend = strend, \
c07a80fd 217 cx->sb_rx = rx, \
79072805
LW
218 cx->cx_type = CXt_SUBST
219
220#define POPSUBST(cx) cxstack_ix--
221
222struct context {
223 I32 cx_type; /* what kind of context this is */
224 union {
225 struct block cx_blk;
226 struct subst cx_subst;
227 } cx_u;
228};
229#define CXt_NULL 0
230#define CXt_SUB 1
231#define CXt_EVAL 2
232#define CXt_LOOP 3
233#define CXt_SUBST 4
234#define CXt_BLOCK 5
235
236#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
237
238/* "gimme" values */
a0d0e21e
LW
239#define G_SCALAR 0
240#define G_ARRAY 1
79072805 241
a0d0e21e
LW
242/* extra flags for perl_call_* routines */
243#define G_DISCARD 2 /* Call FREETMPS. */
244#define G_EVAL 4 /* Assume eval {} around subroutine call. */
245#define G_NOARGS 8 /* Don't construct a @_ array. */
4633a7c4 246#define G_KEEPERR 16 /* Append errors to $@ rather than overwriting it */