Mercurial > repo
comparison perl-5.22.2/pp.h @ 8045:a16537d2fe07
<xfix> tar xf perl-5.22.2.tar.gz # Ah, whatever, I\'m doing it anyway
author | HackBot |
---|---|
date | Sat, 14 May 2016 14:54:38 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
8044:711c038a7dce | 8045:a16537d2fe07 |
---|---|
1 /* pp.h | |
2 * | |
3 * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, | |
4 * 2002, 2003, 2004, 2005, 2006, 2007, 2008 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 */ | |
10 | |
11 #define PP(s) OP * Perl_##s(pTHX) | |
12 | |
13 /* | |
14 =head1 Stack Manipulation Macros | |
15 | |
16 =for apidoc AmU||SP | |
17 Stack pointer. This is usually handled by C<xsubpp>. See C<dSP> and | |
18 C<SPAGAIN>. | |
19 | |
20 =for apidoc AmU||MARK | |
21 Stack marker variable for the XSUB. See C<dMARK>. | |
22 | |
23 =for apidoc Am|void|PUSHMARK|SP | |
24 Opening bracket for arguments on a callback. See C<PUTBACK> and | |
25 L<perlcall>. | |
26 | |
27 =for apidoc Ams||dSP | |
28 Declares a local copy of perl's stack pointer for the XSUB, available via | |
29 the C<SP> macro. See C<SP>. | |
30 | |
31 =for apidoc ms||djSP | |
32 | |
33 Declare Just C<SP>. This is actually identical to C<dSP>, and declares | |
34 a local copy of perl's stack pointer, available via the C<SP> macro. | |
35 See C<SP>. (Available for backward source code compatibility with the | |
36 old (Perl 5.005) thread model.) | |
37 | |
38 =for apidoc Ams||dMARK | |
39 Declare a stack marker variable, C<mark>, for the XSUB. See C<MARK> and | |
40 C<dORIGMARK>. | |
41 | |
42 =for apidoc Ams||dORIGMARK | |
43 Saves the original stack mark for the XSUB. See C<ORIGMARK>. | |
44 | |
45 =for apidoc AmU||ORIGMARK | |
46 The original stack mark for the XSUB. See C<dORIGMARK>. | |
47 | |
48 =for apidoc Ams||SPAGAIN | |
49 Refetch the stack pointer. Used after a callback. See L<perlcall>. | |
50 | |
51 =cut */ | |
52 | |
53 #undef SP /* Solaris 2.7 i386 has this in /usr/include/sys/reg.h */ | |
54 #define SP sp | |
55 #define MARK mark | |
56 #define TARG targ | |
57 | |
58 #define PUSHMARK(p) \ | |
59 STMT_START { \ | |
60 I32 * mark_stack_entry; \ | |
61 if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr) == PL_markstack_max)) \ | |
62 mark_stack_entry = markstack_grow(); \ | |
63 *mark_stack_entry = (I32)((p) - PL_stack_base); \ | |
64 } STMT_END | |
65 | |
66 #define TOPMARK (*PL_markstack_ptr) | |
67 #define POPMARK (*PL_markstack_ptr--) | |
68 | |
69 #define dSP SV **sp = PL_stack_sp | |
70 #define djSP dSP | |
71 #define dMARK SV **mark = PL_stack_base + POPMARK | |
72 #define dORIGMARK const I32 origmark = (I32)(mark - PL_stack_base) | |
73 #define ORIGMARK (PL_stack_base + origmark) | |
74 | |
75 #define SPAGAIN sp = PL_stack_sp | |
76 #define MSPAGAIN STMT_START { sp = PL_stack_sp; mark = ORIGMARK; } STMT_END | |
77 | |
78 #define GETTARGETSTACKED targ = (PL_op->op_flags & OPf_STACKED ? POPs : PAD_SV(PL_op->op_targ)) | |
79 #define dTARGETSTACKED SV * GETTARGETSTACKED | |
80 | |
81 #define GETTARGET targ = PAD_SV(PL_op->op_targ) | |
82 #define dTARGET SV * GETTARGET | |
83 | |
84 #define GETATARGET targ = (PL_op->op_flags & OPf_STACKED ? sp[-1] : PAD_SV(PL_op->op_targ)) | |
85 #define dATARGET SV * GETATARGET | |
86 | |
87 #define dTARG SV *targ | |
88 | |
89 #define NORMAL PL_op->op_next | |
90 #define DIE return Perl_die | |
91 | |
92 /* | |
93 =for apidoc Ams||PUTBACK | |
94 Closing bracket for XSUB arguments. This is usually handled by C<xsubpp>. | |
95 See C<PUSHMARK> and L<perlcall> for other uses. | |
96 | |
97 =for apidoc Amn|SV*|POPs | |
98 Pops an SV off the stack. | |
99 | |
100 =for apidoc Amn|char*|POPp | |
101 Pops a string off the stack. | |
102 | |
103 =for apidoc Amn|char*|POPpx | |
104 Pops a string off the stack. Identical to POPp. There are two names for | |
105 historical reasons. | |
106 | |
107 =for apidoc Amn|char*|POPpbytex | |
108 Pops a string off the stack which must consist of bytes i.e. characters < 256. | |
109 | |
110 =for apidoc Amn|NV|POPn | |
111 Pops a double off the stack. | |
112 | |
113 =for apidoc Amn|IV|POPi | |
114 Pops an integer off the stack. | |
115 | |
116 =for apidoc Amn|long|POPl | |
117 Pops a long off the stack. | |
118 | |
119 =cut | |
120 */ | |
121 | |
122 #define PUTBACK PL_stack_sp = sp | |
123 #define RETURN return (PUTBACK, NORMAL) | |
124 #define RETURNOP(o) return (PUTBACK, o) | |
125 #define RETURNX(x) return (x, PUTBACK, NORMAL) | |
126 | |
127 #define POPs (*sp--) | |
128 #define POPp POPpx | |
129 #define POPpx (SvPVx_nolen(POPs)) | |
130 #define POPpconstx (SvPVx_nolen_const(POPs)) | |
131 #define POPpbytex (SvPVbytex_nolen(POPs)) | |
132 #define POPn (SvNVx(POPs)) | |
133 #define POPi ((IV)SvIVx(POPs)) | |
134 #define POPu ((UV)SvUVx(POPs)) | |
135 #define POPl ((long)SvIVx(POPs)) | |
136 #define POPul ((unsigned long)SvIVx(POPs)) | |
137 | |
138 #define TOPs (*sp) | |
139 #define TOPm1s (*(sp-1)) | |
140 #define TOPp1s (*(sp+1)) | |
141 #define TOPp TOPpx | |
142 #define TOPpx (SvPV_nolen(TOPs)) | |
143 #define TOPn (SvNV(TOPs)) | |
144 #define TOPi ((IV)SvIV(TOPs)) | |
145 #define TOPu ((UV)SvUV(TOPs)) | |
146 #define TOPl ((long)SvIV(TOPs)) | |
147 #define TOPul ((unsigned long)SvUV(TOPs)) | |
148 | |
149 /* Go to some pains in the rare event that we must extend the stack. */ | |
150 | |
151 /* | |
152 =for apidoc Am|void|EXTEND|SP|SSize_t nitems | |
153 Used to extend the argument stack for an XSUB's return values. Once | |
154 used, guarantees that there is room for at least C<nitems> to be pushed | |
155 onto the stack. | |
156 | |
157 =for apidoc Am|void|PUSHs|SV* sv | |
158 Push an SV onto the stack. The stack must have room for this element. | |
159 Does not handle 'set' magic. Does not use C<TARG>. See also C<PUSHmortal>, | |
160 C<XPUSHs> and C<XPUSHmortal>. | |
161 | |
162 =for apidoc Am|void|PUSHp|char* str|STRLEN len | |
163 Push a string onto the stack. The stack must have room for this element. | |
164 The C<len> indicates the length of the string. Handles 'set' magic. Uses | |
165 C<TARG>, so C<dTARGET> or C<dXSTARG> should be called to declare it. Do not | |
166 call multiple C<TARG>-oriented macros to return lists from XSUB's - see | |
167 C<mPUSHp> instead. See also C<XPUSHp> and C<mXPUSHp>. | |
168 | |
169 =for apidoc Am|void|PUSHn|NV nv | |
170 Push a double onto the stack. The stack must have room for this element. | |
171 Handles 'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be | |
172 called to declare it. Do not call multiple C<TARG>-oriented macros to | |
173 return lists from XSUB's - see C<mPUSHn> instead. See also C<XPUSHn> and | |
174 C<mXPUSHn>. | |
175 | |
176 =for apidoc Am|void|PUSHi|IV iv | |
177 Push an integer onto the stack. The stack must have room for this element. | |
178 Handles 'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be | |
179 called to declare it. Do not call multiple C<TARG>-oriented macros to | |
180 return lists from XSUB's - see C<mPUSHi> instead. See also C<XPUSHi> and | |
181 C<mXPUSHi>. | |
182 | |
183 =for apidoc Am|void|PUSHu|UV uv | |
184 Push an unsigned integer onto the stack. The stack must have room for this | |
185 element. Handles 'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> | |
186 should be called to declare it. Do not call multiple C<TARG>-oriented | |
187 macros to return lists from XSUB's - see C<mPUSHu> instead. See also | |
188 C<XPUSHu> and C<mXPUSHu>. | |
189 | |
190 =for apidoc Am|void|XPUSHs|SV* sv | |
191 Push an SV onto the stack, extending the stack if necessary. Does not | |
192 handle 'set' magic. Does not use C<TARG>. See also C<XPUSHmortal>, | |
193 C<PUSHs> and C<PUSHmortal>. | |
194 | |
195 =for apidoc Am|void|XPUSHp|char* str|STRLEN len | |
196 Push a string onto the stack, extending the stack if necessary. The C<len> | |
197 indicates the length of the string. Handles 'set' magic. Uses C<TARG>, so | |
198 C<dTARGET> or C<dXSTARG> should be called to declare it. Do not call | |
199 multiple C<TARG>-oriented macros to return lists from XSUB's - see | |
200 C<mXPUSHp> instead. See also C<PUSHp> and C<mPUSHp>. | |
201 | |
202 =for apidoc Am|void|XPUSHn|NV nv | |
203 Push a double onto the stack, extending the stack if necessary. Handles | |
204 'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be called to | |
205 declare it. Do not call multiple C<TARG>-oriented macros to return lists | |
206 from XSUB's - see C<mXPUSHn> instead. See also C<PUSHn> and C<mPUSHn>. | |
207 | |
208 =for apidoc Am|void|XPUSHi|IV iv | |
209 Push an integer onto the stack, extending the stack if necessary. Handles | |
210 'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be called to | |
211 declare it. Do not call multiple C<TARG>-oriented macros to return lists | |
212 from XSUB's - see C<mXPUSHi> instead. See also C<PUSHi> and C<mPUSHi>. | |
213 | |
214 =for apidoc Am|void|XPUSHu|UV uv | |
215 Push an unsigned integer onto the stack, extending the stack if necessary. | |
216 Handles 'set' magic. Uses C<TARG>, so C<dTARGET> or C<dXSTARG> should be | |
217 called to declare it. Do not call multiple C<TARG>-oriented macros to | |
218 return lists from XSUB's - see C<mXPUSHu> instead. See also C<PUSHu> and | |
219 C<mPUSHu>. | |
220 | |
221 =for apidoc Am|void|mPUSHs|SV* sv | |
222 Push an SV onto the stack and mortalizes the SV. The stack must have room | |
223 for this element. Does not use C<TARG>. See also C<PUSHs> and C<mXPUSHs>. | |
224 | |
225 =for apidoc Am|void|PUSHmortal | |
226 Push a new mortal SV onto the stack. The stack must have room for this | |
227 element. Does not use C<TARG>. See also C<PUSHs>, C<XPUSHmortal> and C<XPUSHs>. | |
228 | |
229 =for apidoc Am|void|mPUSHp|char* str|STRLEN len | |
230 Push a string onto the stack. The stack must have room for this element. | |
231 The C<len> indicates the length of the string. Does not use C<TARG>. | |
232 See also C<PUSHp>, C<mXPUSHp> and C<XPUSHp>. | |
233 | |
234 =for apidoc Am|void|mPUSHn|NV nv | |
235 Push a double onto the stack. The stack must have room for this element. | |
236 Does not use C<TARG>. See also C<PUSHn>, C<mXPUSHn> and C<XPUSHn>. | |
237 | |
238 =for apidoc Am|void|mPUSHi|IV iv | |
239 Push an integer onto the stack. The stack must have room for this element. | |
240 Does not use C<TARG>. See also C<PUSHi>, C<mXPUSHi> and C<XPUSHi>. | |
241 | |
242 =for apidoc Am|void|mPUSHu|UV uv | |
243 Push an unsigned integer onto the stack. The stack must have room for this | |
244 element. Does not use C<TARG>. See also C<PUSHu>, C<mXPUSHu> and C<XPUSHu>. | |
245 | |
246 =for apidoc Am|void|mXPUSHs|SV* sv | |
247 Push an SV onto the stack, extending the stack if necessary and mortalizes | |
248 the SV. Does not use C<TARG>. See also C<XPUSHs> and C<mPUSHs>. | |
249 | |
250 =for apidoc Am|void|XPUSHmortal | |
251 Push a new mortal SV onto the stack, extending the stack if necessary. | |
252 Does not use C<TARG>. See also C<XPUSHs>, C<PUSHmortal> and C<PUSHs>. | |
253 | |
254 =for apidoc Am|void|mXPUSHp|char* str|STRLEN len | |
255 Push a string onto the stack, extending the stack if necessary. The C<len> | |
256 indicates the length of the string. Does not use C<TARG>. See also C<XPUSHp>, | |
257 C<mPUSHp> and C<PUSHp>. | |
258 | |
259 =for apidoc Am|void|mXPUSHn|NV nv | |
260 Push a double onto the stack, extending the stack if necessary. | |
261 Does not use C<TARG>. See also C<XPUSHn>, C<mPUSHn> and C<PUSHn>. | |
262 | |
263 =for apidoc Am|void|mXPUSHi|IV iv | |
264 Push an integer onto the stack, extending the stack if necessary. | |
265 Does not use C<TARG>. See also C<XPUSHi>, C<mPUSHi> and C<PUSHi>. | |
266 | |
267 =for apidoc Am|void|mXPUSHu|UV uv | |
268 Push an unsigned integer onto the stack, extending the stack if necessary. | |
269 Does not use C<TARG>. See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>. | |
270 | |
271 =cut | |
272 */ | |
273 | |
274 #ifdef STRESS_REALLOC | |
275 # define EXTEND(p,n) STMT_START { \ | |
276 sp = stack_grow(sp,p,(SSize_t) (n)); \ | |
277 PERL_UNUSED_VAR(sp); \ | |
278 } STMT_END | |
279 /* Same thing, but update mark register too. */ | |
280 # define MEXTEND(p,n) STMT_START { \ | |
281 const SSize_t markoff = mark - PL_stack_base; \ | |
282 sp = stack_grow(sp,p,(SSize_t) (n)); \ | |
283 mark = PL_stack_base + markoff; \ | |
284 PERL_UNUSED_VAR(sp); \ | |
285 } STMT_END | |
286 #else | |
287 # define EXTEND(p,n) STMT_START { \ | |
288 if (UNLIKELY(PL_stack_max - p < (SSize_t)(n))) { \ | |
289 sp = stack_grow(sp,p,(SSize_t) (n)); \ | |
290 PERL_UNUSED_VAR(sp); \ | |
291 } } STMT_END | |
292 /* Same thing, but update mark register too. */ | |
293 # define MEXTEND(p,n) STMT_START { \ | |
294 if (UNLIKELY(PL_stack_max - p < (SSize_t)(n))) { \ | |
295 const SSize_t markoff = mark - PL_stack_base; \ | |
296 sp = stack_grow(sp,p,(SSize_t) (n)); \ | |
297 mark = PL_stack_base + markoff; \ | |
298 PERL_UNUSED_VAR(sp); \ | |
299 } } STMT_END | |
300 #endif | |
301 | |
302 #define PUSHs(s) (*++sp = (s)) | |
303 #define PUSHTARG STMT_START { SvSETMAGIC(TARG); PUSHs(TARG); } STMT_END | |
304 #define PUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); PUSHTARG; } STMT_END | |
305 #define PUSHn(n) STMT_START { sv_setnv(TARG, (NV)(n)); PUSHTARG; } STMT_END | |
306 #define PUSHi(i) STMT_START { sv_setiv(TARG, (IV)(i)); PUSHTARG; } STMT_END | |
307 #define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END | |
308 | |
309 #define XPUSHs(s) STMT_START { EXTEND(sp,1); *++sp = (s); } STMT_END | |
310 #define XPUSHTARG STMT_START { SvSETMAGIC(TARG); XPUSHs(TARG); } STMT_END | |
311 #define XPUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); XPUSHTARG; } STMT_END | |
312 #define XPUSHn(n) STMT_START { sv_setnv(TARG, (NV)(n)); XPUSHTARG; } STMT_END | |
313 #define XPUSHi(i) STMT_START { sv_setiv(TARG, (IV)(i)); XPUSHTARG; } STMT_END | |
314 #define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END | |
315 #define XPUSHundef STMT_START { SvOK_off(TARG); XPUSHs(TARG); } STMT_END | |
316 | |
317 #define mPUSHs(s) PUSHs(sv_2mortal(s)) | |
318 #define PUSHmortal PUSHs(sv_newmortal()) | |
319 #define mPUSHp(p,l) PUSHs(newSVpvn_flags((p), (l), SVs_TEMP)) | |
320 #define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n)) | |
321 #define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i)) | |
322 #define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u)) | |
323 | |
324 #define mXPUSHs(s) XPUSHs(sv_2mortal(s)) | |
325 #define XPUSHmortal XPUSHs(sv_newmortal()) | |
326 #define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); mPUSHp((p), (l)); } STMT_END | |
327 #define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END | |
328 #define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END | |
329 #define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END | |
330 | |
331 #define SETs(s) (*sp = s) | |
332 #define SETTARG STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END | |
333 #define SETp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); SETTARG; } STMT_END | |
334 #define SETn(n) STMT_START { sv_setnv(TARG, (NV)(n)); SETTARG; } STMT_END | |
335 #define SETi(i) STMT_START { sv_setiv(TARG, (IV)(i)); SETTARG; } STMT_END | |
336 #define SETu(u) STMT_START { sv_setuv(TARG, (UV)(u)); SETTARG; } STMT_END | |
337 | |
338 #define dTOPss SV *sv = TOPs | |
339 #define dPOPss SV *sv = POPs | |
340 #define dTOPnv NV value = TOPn | |
341 #define dPOPnv NV value = POPn | |
342 #define dPOPnv_nomg NV value = (sp--, SvNV_nomg(TOPp1s)) | |
343 #define dTOPiv IV value = TOPi | |
344 #define dPOPiv IV value = POPi | |
345 #define dTOPuv UV value = TOPu | |
346 #define dPOPuv UV value = POPu | |
347 | |
348 #define dPOPXssrl(X) SV *right = POPs; SV *left = CAT2(X,s) | |
349 #define dPOPXnnrl(X) NV right = POPn; NV left = CAT2(X,n) | |
350 #define dPOPXiirl(X) IV right = POPi; IV left = CAT2(X,i) | |
351 | |
352 #define USE_LEFT(sv) \ | |
353 (SvOK(sv) || !(PL_op->op_flags & OPf_STACKED)) | |
354 #define dPOPXiirl_ul_nomg(X) \ | |
355 IV right = (sp--, SvIV_nomg(TOPp1s)); \ | |
356 SV *leftsv = CAT2(X,s); \ | |
357 IV left = USE_LEFT(leftsv) ? SvIV_nomg(leftsv) : 0 | |
358 | |
359 #define dPOPPOPssrl dPOPXssrl(POP) | |
360 #define dPOPPOPnnrl dPOPXnnrl(POP) | |
361 #define dPOPPOPiirl dPOPXiirl(POP) | |
362 | |
363 #define dPOPTOPssrl dPOPXssrl(TOP) | |
364 #define dPOPTOPnnrl dPOPXnnrl(TOP) | |
365 #define dPOPTOPnnrl_nomg \ | |
366 NV right = SvNV_nomg(TOPs); NV left = (sp--, SvNV_nomg(TOPs)) | |
367 #define dPOPTOPiirl dPOPXiirl(TOP) | |
368 #define dPOPTOPiirl_ul_nomg dPOPXiirl_ul_nomg(TOP) | |
369 #define dPOPTOPiirl_nomg \ | |
370 IV right = SvIV_nomg(TOPs); IV left = (sp--, SvIV_nomg(TOPs)) | |
371 | |
372 #define RETPUSHYES RETURNX(PUSHs(&PL_sv_yes)) | |
373 #define RETPUSHNO RETURNX(PUSHs(&PL_sv_no)) | |
374 #define RETPUSHUNDEF RETURNX(PUSHs(&PL_sv_undef)) | |
375 | |
376 #define RETSETYES RETURNX(SETs(&PL_sv_yes)) | |
377 #define RETSETNO RETURNX(SETs(&PL_sv_no)) | |
378 #define RETSETUNDEF RETURNX(SETs(&PL_sv_undef)) | |
379 #define RETSETTARG STMT_START { SETTARG; RETURN; } STMT_END | |
380 | |
381 #define ARGTARG PL_op->op_targ | |
382 | |
383 #define MAXARG (PL_op->op_private & OPpARG4_MASK) | |
384 | |
385 #define SWITCHSTACK(f,t) \ | |
386 STMT_START { \ | |
387 AvFILLp(f) = sp - PL_stack_base; \ | |
388 PL_stack_base = AvARRAY(t); \ | |
389 PL_stack_max = PL_stack_base + AvMAX(t); \ | |
390 sp = PL_stack_sp = PL_stack_base + AvFILLp(t); \ | |
391 PL_curstack = t; \ | |
392 } STMT_END | |
393 | |
394 #define EXTEND_MORTAL(n) \ | |
395 STMT_START { \ | |
396 SSize_t eMiX = PL_tmps_ix + (n); \ | |
397 if (UNLIKELY(eMiX >= PL_tmps_max)) \ | |
398 (void)Perl_tmps_grow_p(aTHX_ eMiX); \ | |
399 } STMT_END | |
400 | |
401 #define AMGf_noright 1 | |
402 #define AMGf_noleft 2 | |
403 #define AMGf_assign 4 | |
404 #define AMGf_unary 8 | |
405 #define AMGf_numeric 0x10 /* for Perl_try_amagic_bin */ | |
406 #define AMGf_set 0x20 /* for Perl_try_amagic_bin */ | |
407 #define AMGf_want_list 0x40 | |
408 #define AMGf_numarg 0x80 | |
409 | |
410 | |
411 /* do SvGETMAGIC on the stack args before checking for overload */ | |
412 | |
413 #define tryAMAGICun_MG(method, flags) STMT_START { \ | |
414 if ( UNLIKELY((SvFLAGS(TOPs) & (SVf_ROK|SVs_GMG))) \ | |
415 && Perl_try_amagic_un(aTHX_ method, flags)) \ | |
416 return NORMAL; \ | |
417 } STMT_END | |
418 #define tryAMAGICbin_MG(method, flags) STMT_START { \ | |
419 if ( UNLIKELY(((SvFLAGS(TOPm1s)|SvFLAGS(TOPs)) & (SVf_ROK|SVs_GMG))) \ | |
420 && Perl_try_amagic_bin(aTHX_ method, flags)) \ | |
421 return NORMAL; \ | |
422 } STMT_END | |
423 | |
424 #define AMG_CALLunary(sv,meth) \ | |
425 amagic_call(sv,&PL_sv_undef, meth, AMGf_noright | AMGf_unary) | |
426 | |
427 /* No longer used in core. Use AMG_CALLunary instead */ | |
428 #define AMG_CALLun(sv,meth) AMG_CALLunary(sv, CAT2(meth,_amg)) | |
429 | |
430 #define tryAMAGICunTARGETlist(meth, jump) \ | |
431 STMT_START { \ | |
432 dSP; \ | |
433 SV *tmpsv; \ | |
434 SV *arg= *sp; \ | |
435 int gimme = GIMME_V; \ | |
436 if (UNLIKELY(SvAMAGIC(arg) && \ | |
437 (tmpsv = amagic_call(arg, &PL_sv_undef, meth, \ | |
438 AMGf_want_list | AMGf_noright \ | |
439 |AMGf_unary)))) \ | |
440 { \ | |
441 SPAGAIN; \ | |
442 if (gimme == G_VOID) { \ | |
443 NOOP; \ | |
444 } \ | |
445 else if (gimme == G_ARRAY) { \ | |
446 SSize_t i; \ | |
447 SSize_t len; \ | |
448 assert(SvTYPE(tmpsv) == SVt_PVAV); \ | |
449 len = av_tindex((AV *)tmpsv) + 1; \ | |
450 (void)POPs; /* get rid of the arg */ \ | |
451 EXTEND(sp, len); \ | |
452 for (i = 0; i < len; ++i) \ | |
453 PUSHs(av_shift((AV *)tmpsv)); \ | |
454 } \ | |
455 else { /* AMGf_want_scalar */ \ | |
456 dATARGET; /* just use the arg's location */ \ | |
457 sv_setsv(TARG, tmpsv); \ | |
458 if (opASSIGN) \ | |
459 sp--; \ | |
460 SETTARG; \ | |
461 } \ | |
462 PUTBACK; \ | |
463 if (jump) { \ | |
464 OP *jump_o = NORMAL->op_next; \ | |
465 while (jump_o->op_type == OP_NULL) \ | |
466 jump_o = jump_o->op_next; \ | |
467 assert(jump_o->op_type == OP_ENTERSUB); \ | |
468 PL_markstack_ptr--; \ | |
469 return jump_o->op_next; \ | |
470 } \ | |
471 return NORMAL; \ | |
472 } \ | |
473 } STMT_END | |
474 | |
475 /* This is no longer used anywhere in the core. You might wish to consider | |
476 calling amagic_deref_call() directly, as it has a cleaner interface. */ | |
477 #define tryAMAGICunDEREF(meth) \ | |
478 STMT_START { \ | |
479 sv = amagic_deref_call(*sp, CAT2(meth,_amg)); \ | |
480 SPAGAIN; \ | |
481 } STMT_END | |
482 | |
483 | |
484 #define opASSIGN (PL_op->op_flags & OPf_STACKED) | |
485 | |
486 /* | |
487 =for apidoc mU||LVRET | |
488 True if this op will be the return value of an lvalue subroutine | |
489 | |
490 =cut */ | |
491 #define LVRET ((PL_op->op_private & OPpMAYBE_LVSUB) && is_lvalue_sub()) | |
492 | |
493 #define SvCANEXISTDELETE(sv) \ | |
494 (!SvRMAGICAL(sv) \ | |
495 || !(mg = mg_find((const SV *) sv, PERL_MAGIC_tied)) \ | |
496 || ( (stash = SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(sv), mg)))) \ | |
497 && gv_fetchmethod_autoload(stash, "EXISTS", TRUE) \ | |
498 && gv_fetchmethod_autoload(stash, "DELETE", TRUE) \ | |
499 ) \ | |
500 ) | |
501 | |
502 #ifdef PERL_CORE | |
503 | |
504 /* These are just for Perl_tied_method(), which is not part of the public API. | |
505 Use 0x04 rather than the next available bit, to help the compiler if the | |
506 architecture can generate more efficient instructions. */ | |
507 # define TIED_METHOD_MORTALIZE_NOT_NEEDED 0x04 | |
508 # define TIED_METHOD_ARGUMENTS_ON_STACK 0x08 | |
509 # define TIED_METHOD_SAY 0x10 | |
510 | |
511 /* Used in various places that need to dereference a glob or globref */ | |
512 # define MAYBE_DEREF_GV_flags(sv,phlags) \ | |
513 ( \ | |
514 (void)(phlags & SV_GMAGIC && (SvGETMAGIC(sv),0)), \ | |
515 isGV_with_GP(sv) \ | |
516 ? (GV *)(sv) \ | |
517 : SvROK(sv) && SvTYPE(SvRV(sv)) <= SVt_PVLV && \ | |
518 (SvGETMAGIC(SvRV(sv)), isGV_with_GP(SvRV(sv))) \ | |
519 ? (GV *)SvRV(sv) \ | |
520 : NULL \ | |
521 ) | |
522 # define MAYBE_DEREF_GV(sv) MAYBE_DEREF_GV_flags(sv,SV_GMAGIC) | |
523 # define MAYBE_DEREF_GV_nomg(sv) MAYBE_DEREF_GV_flags(sv,0) | |
524 | |
525 # define FIND_RUNCV_padid_eq 1 | |
526 # define FIND_RUNCV_level_eq 2 | |
527 | |
528 #endif | |
529 | |
530 /* | |
531 * ex: set ts=8 sts=4 sw=4 et: | |
532 */ |