3 * Copyright (c) 1991-2002, 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.
10 #define PP(s) OP * Perl_##s(pTHX)
13 =head1 Stack Manipulation Macros
16 Stack pointer. This is usually handled by C<xsubpp>. See C<dSP> and
20 Stack marker variable for the XSUB. See C<dMARK>.
22 =for apidoc Ams||PUSHMARK
23 Opening bracket for arguments on a callback. See C<PUTBACK> and
27 Declares a local copy of perl's stack pointer for the XSUB, available via
28 the C<SP> macro. See C<SP>.
32 Declare Just C<SP>. This is actually identical to C<dSP>, and declares
33 a local copy of perl's stack pointer, available via the C<SP> macro.
34 See C<SP>. (Available for backward source code compatibility with the
35 old (Perl 5.005) thread model.)
37 =for apidoc Ams||dMARK
38 Declare a stack marker variable, C<mark>, for the XSUB. See C<MARK> and
41 =for apidoc Ams||dORIGMARK
42 Saves the original stack mark for the XSUB. See C<ORIGMARK>.
44 =for apidoc AmU||ORIGMARK
45 The original stack mark for the XSUB. See C<dORIGMARK>.
47 =for apidoc Ams||SPAGAIN
48 Refetch the stack pointer. Used after a callback. See L<perlcall>.
52 #undef SP /* Solaris 2.7 i386 has this in /usr/include/sys/reg.h */
57 #define PUSHMARK(p) if (++PL_markstack_ptr == PL_markstack_max) \
59 *PL_markstack_ptr = (p) - PL_stack_base
61 #define TOPMARK (*PL_markstack_ptr)
62 #define POPMARK (*PL_markstack_ptr--)
64 #define dSP register SV **sp = PL_stack_sp
66 #define dMARK register SV **mark = PL_stack_base + POPMARK
67 #define dORIGMARK I32 origmark = mark - PL_stack_base
68 #define SETORIGMARK origmark = mark - PL_stack_base
69 #define ORIGMARK (PL_stack_base + origmark)
71 #define SPAGAIN sp = PL_stack_sp
72 #define MSPAGAIN sp = PL_stack_sp; mark = ORIGMARK
74 #define GETTARGETSTACKED targ = (PL_op->op_flags & OPf_STACKED ? POPs : PAD_SV(PL_op->op_targ))
75 #define dTARGETSTACKED SV * GETTARGETSTACKED
77 #define GETTARGET targ = PAD_SV(PL_op->op_targ)
78 #define dTARGET SV * GETTARGET
80 #define GETATARGET targ = (PL_op->op_flags & OPf_STACKED ? sp[-1] : PAD_SV(PL_op->op_targ))
81 #define dATARGET SV * GETATARGET
83 #define dTARG SV *targ
85 #define NORMAL PL_op->op_next
86 #define DIE return Perl_die
89 =for apidoc Ams||PUTBACK
90 Closing bracket for XSUB arguments. This is usually handled by C<xsubpp>.
91 See C<PUSHMARK> and L<perlcall> for other uses.
93 =for apidoc Amn|SV*|POPs
94 Pops an SV off the stack.
96 =for apidoc Amn|char*|POPp
97 Pops a string off the stack. Deprecated. New code should provide
98 a STRLEN n_a and use POPpx.
100 =for apidoc Amn|char*|POPpx
101 Pops a string off the stack.
102 Requires a variable STRLEN n_a in scope.
104 =for apidoc Amn|char*|POPpbytex
105 Pops a string off the stack which must consist of bytes i.e. characters < 256.
106 Requires a variable STRLEN n_a in scope.
108 =for apidoc Amn|NV|POPn
109 Pops a double off the stack.
111 =for apidoc Amn|IV|POPi
112 Pops an integer off the stack.
114 =for apidoc Amn|long|POPl
115 Pops a long off the stack.
120 #define PUTBACK PL_stack_sp = sp
121 #define RETURN return PUTBACK, NORMAL
122 #define RETURNOP(o) return PUTBACK, o
123 #define RETURNX(x) return x, PUTBACK, NORMAL
126 #define POPp (SvPVx(POPs, PL_na)) /* deprecated */
127 #define POPpx (SvPVx(POPs, n_a))
128 #define POPpbytex (SvPVbytex(POPs, n_a))
129 #define POPn (SvNVx(POPs))
130 #define POPi ((IV)SvIVx(POPs))
131 #define POPu ((UV)SvUVx(POPs))
132 #define POPl ((long)SvIVx(POPs))
133 #define POPul ((unsigned long)SvIVx(POPs))
135 #define POPq ((Quad_t)SvIVx(POPs))
136 #define POPuq ((Uquad_t)SvUVx(POPs))
140 #define TOPm1s (*(sp-1))
141 #define TOPp1s (*(sp+1))
142 #define TOPp (SvPV(TOPs, PL_na)) /* deprecated */
143 #define TOPpx (SvPV(TOPs, n_a))
144 #define TOPn (SvNV(TOPs))
145 #define TOPi ((IV)SvIV(TOPs))
146 #define TOPu ((UV)SvUV(TOPs))
147 #define TOPl ((long)SvIV(TOPs))
148 #define TOPul ((unsigned long)SvUV(TOPs))
150 #define TOPq ((Quad_t)SvIV(TOPs))
151 #define TOPuq ((Uquad_t)SvUV(TOPs))
154 /* Go to some pains in the rare event that we must extend the stack. */
157 =for apidoc Am|void|EXTEND|SP|int nitems
158 Used to extend the argument stack for an XSUB's return values. Once
159 used, guarantees that there is room for at least C<nitems> to be pushed
162 =for apidoc Am|void|PUSHs|SV* sv
163 Push an SV onto the stack. The stack must have room for this element.
164 Does not handle 'set' magic. See C<XPUSHs>.
166 =for apidoc Am|void|PUSHp|char* str|STRLEN len
167 Push a string onto the stack. The stack must have room for this element.
168 The C<len> indicates the length of the string. Handles 'set' magic. See
171 =for apidoc Am|void|PUSHn|NV nv
172 Push a double onto the stack. The stack must have room for this element.
173 Handles 'set' magic. See C<XPUSHn>.
175 =for apidoc Am|void|PUSHi|IV iv
176 Push an integer onto the stack. The stack must have room for this element.
177 Handles 'set' magic. See C<XPUSHi>.
179 =for apidoc Am|void|PUSHu|UV uv
180 Push an unsigned integer onto the stack. The stack must have room for this
181 element. See C<XPUSHu>.
183 =for apidoc Am|void|XPUSHs|SV* sv
184 Push an SV onto the stack, extending the stack if necessary. Does not
185 handle 'set' magic. See C<PUSHs>.
187 =for apidoc Am|void|XPUSHp|char* str|STRLEN len
188 Push a string onto the stack, extending the stack if necessary. The C<len>
189 indicates the length of the string. Handles 'set' magic. See
192 =for apidoc Am|void|XPUSHn|NV nv
193 Push a double onto the stack, extending the stack if necessary. Handles
194 'set' magic. See C<PUSHn>.
196 =for apidoc Am|void|XPUSHi|IV iv
197 Push an integer onto the stack, extending the stack if necessary. Handles
198 'set' magic. See C<PUSHi>.
200 =for apidoc Am|void|XPUSHu|UV uv
201 Push an unsigned integer onto the stack, extending the stack if necessary.
207 #define EXTEND(p,n) STMT_START { if (PL_stack_max - p < (n)) { \
208 sp = stack_grow(sp,p, (int) (n)); \
211 /* Same thing, but update mark register too. */
212 #define MEXTEND(p,n) STMT_START {if (PL_stack_max - p < (n)) { \
213 int markoff = mark - PL_stack_base; \
214 sp = stack_grow(sp,p,(int) (n)); \
215 mark = PL_stack_base + markoff; \
218 #define PUSHs(s) (*++sp = (s))
219 #define PUSHTARG STMT_START { SvSETMAGIC(TARG); PUSHs(TARG); } STMT_END
220 #define PUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); PUSHTARG; } STMT_END
221 #define PUSHn(n) STMT_START { sv_setnv(TARG, (NV)(n)); PUSHTARG; } STMT_END
222 #define PUSHi(i) STMT_START { sv_setiv(TARG, (IV)(i)); PUSHTARG; } STMT_END
223 #define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
225 #define XPUSHs(s) STMT_START { EXTEND(sp,1); (*++sp = (s)); } STMT_END
226 #define XPUSHTARG STMT_START { SvSETMAGIC(TARG); XPUSHs(TARG); } STMT_END
227 #define XPUSHp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); XPUSHTARG; } STMT_END
228 #define XPUSHn(n) STMT_START { sv_setnv(TARG, (NV)(n)); XPUSHTARG; } STMT_END
229 #define XPUSHi(i) STMT_START { sv_setiv(TARG, (IV)(i)); XPUSHTARG; } STMT_END
230 #define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
231 #define XPUSHundef STMT_START { SvOK_off(TARG); XPUSHs(TARG); } STMT_END
233 #define SETs(s) (*sp = s)
234 #define SETTARG STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END
235 #define SETp(p,l) STMT_START { sv_setpvn(TARG, (p), (l)); SETTARG; } STMT_END
236 #define SETn(n) STMT_START { sv_setnv(TARG, (NV)(n)); SETTARG; } STMT_END
237 #define SETi(i) STMT_START { sv_setiv(TARG, (IV)(i)); SETTARG; } STMT_END
238 #define SETu(u) STMT_START { sv_setuv(TARG, (UV)(u)); SETTARG; } STMT_END
240 #define dTOPss SV *sv = TOPs
241 #define dPOPss SV *sv = POPs
242 #define dTOPnv NV value = TOPn
243 #define dPOPnv NV value = POPn
244 #define dTOPiv IV value = TOPi
245 #define dPOPiv IV value = POPi
246 #define dTOPuv UV value = TOPu
247 #define dPOPuv UV value = POPu
249 #define dTOPqv Quad_t value = TOPu
250 #define dPOPqv Quad_t value = POPu
251 #define dTOPuqv Uquad_t value = TOPuq
252 #define dPOPuqv Uquad_t value = POPuq
255 #define dPOPXssrl(X) SV *right = POPs; SV *left = CAT2(X,s)
256 #define dPOPXnnrl(X) NV right = POPn; NV left = CAT2(X,n)
257 #define dPOPXiirl(X) IV right = POPi; IV left = CAT2(X,i)
259 #define USE_LEFT(sv) \
260 (SvOK(sv) || SvGMAGICAL(sv) || !(PL_op->op_flags & OPf_STACKED))
261 #define dPOPXnnrl_ul(X) \
263 SV *leftsv = CAT2(X,s); \
264 NV left = USE_LEFT(leftsv) ? SvNV(leftsv) : 0.0
265 #define dPOPXiirl_ul(X) \
267 SV *leftsv = CAT2(X,s); \
268 IV left = USE_LEFT(leftsv) ? SvIV(leftsv) : 0
270 #define dPOPPOPssrl dPOPXssrl(POP)
271 #define dPOPPOPnnrl dPOPXnnrl(POP)
272 #define dPOPPOPnnrl_ul dPOPXnnrl_ul(POP)
273 #define dPOPPOPiirl dPOPXiirl(POP)
274 #define dPOPPOPiirl_ul dPOPXiirl_ul(POP)
276 #define dPOPTOPssrl dPOPXssrl(TOP)
277 #define dPOPTOPnnrl dPOPXnnrl(TOP)
278 #define dPOPTOPnnrl_ul dPOPXnnrl_ul(TOP)
279 #define dPOPTOPiirl dPOPXiirl(TOP)
280 #define dPOPTOPiirl_ul dPOPXiirl_ul(TOP)
282 #define RETPUSHYES RETURNX(PUSHs(&PL_sv_yes))
283 #define RETPUSHNO RETURNX(PUSHs(&PL_sv_no))
284 #define RETPUSHUNDEF RETURNX(PUSHs(&PL_sv_undef))
286 #define RETSETYES RETURNX(SETs(&PL_sv_yes))
287 #define RETSETNO RETURNX(SETs(&PL_sv_no))
288 #define RETSETUNDEF RETURNX(SETs(&PL_sv_undef))
290 #define ARGTARG PL_op->op_targ
292 /* See OPpTARGET_MY: */
293 #define MAXARG (PL_op->op_private & 15)
295 #define SWITCHSTACK(f,t) \
297 AvFILLp(f) = sp - PL_stack_base; \
298 PL_stack_base = AvARRAY(t); \
299 PL_stack_max = PL_stack_base + AvMAX(t); \
300 sp = PL_stack_sp = PL_stack_base + AvFILLp(t); \
304 #define EXTEND_MORTAL(n) \
306 if (PL_tmps_ix + (n) >= PL_tmps_max) \
310 #define AMGf_noright 1
311 #define AMGf_noleft 2
312 #define AMGf_assign 4
315 #define tryAMAGICbinW(meth,assign,set) STMT_START { \
316 if (PL_amagic_generation) { \
318 SV* right= *(sp); SV* left= *(sp-1);\
319 if ((SvAMAGIC(left)||SvAMAGIC(right))&&\
320 (tmpsv=amagic_call(left, \
323 (assign)? AMGf_assign: 0))) {\
325 (void)POPs; set(tmpsv); RETURN; } \
329 #define tryAMAGICbin(meth,assign) tryAMAGICbinW(meth,assign,SETsv)
330 #define tryAMAGICbinSET(meth,assign) tryAMAGICbinW(meth,assign,SETs)
332 #define AMG_CALLun(sv,meth) amagic_call(sv,&PL_sv_undef, \
333 CAT2(meth,_amg),AMGf_noright | AMGf_unary)
334 #define AMG_CALLbinL(left,right,meth) \
335 amagic_call(left,right,CAT2(meth,_amg),AMGf_noright)
337 #define tryAMAGICunW(meth,set,shift,ret) STMT_START { \
338 if (PL_amagic_generation) { \
340 SV* arg= sp[shift]; \
341 if(0) goto am_again; /* shut up unused warning */ \
343 if ((SvAMAGIC(arg))&&\
344 (tmpsv=AMG_CALLun(arg,meth))) {\
345 SPAGAIN; if (shift) sp += shift; \
350 #define FORCE_SETs(sv) STMT_START { sv_setsv(TARG, (sv)); SETTARG; } STMT_END
352 #define tryAMAGICun(meth) tryAMAGICunW(meth,SETsvUN,0,RETURN)
353 #define tryAMAGICunSET(meth) tryAMAGICunW(meth,SETs,0,RETURN)
354 #define tryAMAGICunTARGET(meth, shift) \
355 { dSP; sp--; /* get TARGET from below PL_stack_sp */ \
357 { dSP; tryAMAGICunW(meth,FORCE_SETs,shift,RETURN);}}}
359 #define setAGAIN(ref) sv = ref; \
361 Perl_croak(aTHX_ "Overloaded dereference did not return a reference"); \
362 if (ref != arg && SvRV(ref) != SvRV(arg)) { \
367 #define tryAMAGICunDEREF(meth) tryAMAGICunW(meth,setAGAIN,0,(void)0)
369 #define opASSIGN (PL_op->op_flags & OPf_STACKED)
370 #define SETsv(sv) STMT_START { \
371 if (opASSIGN || (SvFLAGS(TARG) & SVs_PADMY)) \
372 { sv_setsv(TARG, (sv)); SETTARG; } \
373 else SETs(sv); } STMT_END
375 #define SETsvUN(sv) STMT_START { \
376 if (SvFLAGS(TARG) & SVs_PADMY) \
377 { sv_setsv(TARG, (sv)); SETTARG; } \
378 else SETs(sv); } STMT_END
380 /* newSVsv does not behave as advertised, so we copy missing
381 * information by hand */
383 /* SV* ref causes confusion with the member variable
384 changed SV* ref to SV* tmpRef */
385 #define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv); \
386 if (SvREFCNT(tmpRef)>1) { \
387 SvREFCNT_dec(tmpRef); \
388 SvRV(rv)=AMG_CALLun(rv,copy); \
392 =for apidoc mU||LVRET
393 True if this op will be the return value of an lvalue subroutine
396 #define LVRET ((PL_op->op_private & OPpMAYBE_LVSUB) && is_lvalue_sub())