This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pod/perlipc.pod patch
[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;
96 AV * iterary;
97 I32 iterix;
98};
99
100#define PUSHLOOP(cx, ivar, s) \
101 cx->blk_loop.label = curcop->cop_label; \
102 cx->blk_loop.resetsp = s - stack_base; \
103 cx->blk_loop.redo_op = cLOOP->op_redoop; \
104 cx->blk_loop.next_op = cLOOP->op_nextop; \
105 cx->blk_loop.last_op = cLOOP->op_lastop; \
106 cx->blk_loop.itervar = ivar; \
107 if (ivar) \
108 cx->blk_loop.itersave = *cx->blk_loop.itervar;
109
110#define POPLOOP(cx) \
4633a7c4 111 newsp = stack_base + cx->blk_loop.resetsp;
79072805
LW
112
113/* context common to subroutines, evals and loops */
114struct block {
115 I32 blku_oldsp; /* stack pointer to copy stuff down to */
116 COP * blku_oldcop; /* old curcop pointer */
117 I32 blku_oldretsp; /* return stack index */
118 I32 blku_oldmarksp; /* mark stack index */
119 I32 blku_oldscopesp; /* scope stack index */
120 PMOP * blku_oldpm; /* values of pattern match vars */
121 U8 blku_gimme; /* is this block running in list context? */
122
123 union {
124 struct block_sub blku_sub;
125 struct block_eval blku_eval;
126 struct block_loop blku_loop;
127 } blk_u;
128};
129#define blk_oldsp cx_u.cx_blk.blku_oldsp
130#define blk_oldcop cx_u.cx_blk.blku_oldcop
131#define blk_oldretsp cx_u.cx_blk.blku_oldretsp
132#define blk_oldmarksp cx_u.cx_blk.blku_oldmarksp
133#define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp
134#define blk_oldpm cx_u.cx_blk.blku_oldpm
135#define blk_gimme cx_u.cx_blk.blku_gimme
136#define blk_sub cx_u.cx_blk.blk_u.blku_sub
137#define blk_eval cx_u.cx_blk.blk_u.blku_eval
138#define blk_loop cx_u.cx_blk.blk_u.blku_loop
139
140/* Enter a block. */
8990e307 141#define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \
79072805 142 cx->cx_type = t, \
8990e307 143 cx->blk_oldsp = sp - stack_base, \
79072805
LW
144 cx->blk_oldcop = curcop, \
145 cx->blk_oldmarksp = markstack_ptr - markstack, \
146 cx->blk_oldscopesp = scopestack_ix, \
147 cx->blk_oldretsp = retstack_ix, \
148 cx->blk_oldpm = curpm, \
149 cx->blk_gimme = gimme; \
760ac839 150 DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Entering block %ld, type %s\n", \
a0d0e21e 151 (long)cxstack_ix, block_type[t]); )
79072805
LW
152
153/* Exit a block (RETURN and LAST). */
a0d0e21e 154#define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \
79072805
LW
155 newsp = stack_base + cx->blk_oldsp, \
156 curcop = cx->blk_oldcop, \
157 markstack_ptr = markstack + cx->blk_oldmarksp, \
158 scopestack_ix = cx->blk_oldscopesp, \
159 retstack_ix = cx->blk_oldretsp, \
a0d0e21e 160 pm = cx->blk_oldpm, \
79072805 161 gimme = cx->blk_gimme; \
760ac839 162 DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Leaving block %ld, type %s\n", \
a0d0e21e 163 (long)cxstack_ix+1,block_type[cx->cx_type]); )
79072805
LW
164
165/* Continue a block elsewhere (NEXT and REDO). */
166#define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \
167 stack_sp = stack_base + cx->blk_oldsp, \
168 markstack_ptr = markstack + cx->blk_oldmarksp, \
169 scopestack_ix = cx->blk_oldscopesp, \
170 retstack_ix = cx->blk_oldretsp
171
172/* substitution context */
173struct subst {
174 I32 sbu_iters;
175 I32 sbu_maxiters;
176 I32 sbu_safebase;
177 I32 sbu_once;
4633a7c4 178 I32 sbu_oldsave;
79072805
LW
179 char * sbu_orig;
180 SV * sbu_dstr;
181 SV * sbu_targ;
182 char * sbu_s;
183 char * sbu_m;
184 char * sbu_strend;
185 char * sbu_subbase;
c07a80fd 186 REGEXP * sbu_rx;
79072805
LW
187};
188#define sb_iters cx_u.cx_subst.sbu_iters
189#define sb_maxiters cx_u.cx_subst.sbu_maxiters
190#define sb_safebase cx_u.cx_subst.sbu_safebase
191#define sb_once cx_u.cx_subst.sbu_once
4633a7c4 192#define sb_oldsave cx_u.cx_subst.sbu_oldsave
79072805
LW
193#define sb_orig cx_u.cx_subst.sbu_orig
194#define sb_dstr cx_u.cx_subst.sbu_dstr
195#define sb_targ cx_u.cx_subst.sbu_targ
196#define sb_s cx_u.cx_subst.sbu_s
197#define sb_m cx_u.cx_subst.sbu_m
198#define sb_strend cx_u.cx_subst.sbu_strend
199#define sb_subbase cx_u.cx_subst.sbu_subbase
c07a80fd 200#define sb_rx cx_u.cx_subst.sbu_rx
79072805
LW
201
202#define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \
203 cx->sb_iters = iters, \
204 cx->sb_maxiters = maxiters, \
205 cx->sb_safebase = safebase, \
206 cx->sb_once = once, \
4633a7c4 207 cx->sb_oldsave = oldsave, \
79072805
LW
208 cx->sb_orig = orig, \
209 cx->sb_dstr = dstr, \
210 cx->sb_targ = targ, \
211 cx->sb_s = s, \
212 cx->sb_m = m, \
213 cx->sb_strend = strend, \
c07a80fd 214 cx->sb_rx = rx, \
79072805
LW
215 cx->cx_type = CXt_SUBST
216
217#define POPSUBST(cx) cxstack_ix--
218
219struct context {
220 I32 cx_type; /* what kind of context this is */
221 union {
222 struct block cx_blk;
223 struct subst cx_subst;
224 } cx_u;
225};
226#define CXt_NULL 0
227#define CXt_SUB 1
228#define CXt_EVAL 2
229#define CXt_LOOP 3
230#define CXt_SUBST 4
231#define CXt_BLOCK 5
232
233#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
234
235/* "gimme" values */
a0d0e21e
LW
236#define G_SCALAR 0
237#define G_ARRAY 1
79072805 238
a0d0e21e
LW
239/* extra flags for perl_call_* routines */
240#define G_DISCARD 2 /* Call FREETMPS. */
241#define G_EVAL 4 /* Assume eval {} around subroutine call. */
242#define G_NOARGS 8 /* Don't construct a @_ array. */
4633a7c4 243#define G_KEEPERR 16 /* Append errors to $@ rather than overwriting it */