source: trunk/third/perl/pp.h @ 14545

Revision 14545, 11.5 KB checked in by ghudson, 24 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r14544, which included commits to RCS files with non-trunk default branches.
Line 
1/*    pp.h
2 *
3 *    Copyright (c) 1991-2000, Larry Wall
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 *
8 */
9
10#ifdef USE_THREADS
11#define ARGS thr
12#define dARGS struct perl_thread *thr;
13#else
14#define ARGS
15#define dARGS
16#endif /* USE_THREADS */
17
18#define PP(s) OP * Perl_##s(pTHX)
19
20/*
21=for apidoc AmU||SP
22Stack pointer.  This is usually handled by C<xsubpp>.  See C<dSP> and
23C<SPAGAIN>.
24
25=for apidoc AmU||MARK
26Stack marker variable for the XSUB.  See C<dMARK>.
27
28=for apidoc Ams||PUSHMARK
29Opening bracket for arguments on a callback.  See C<PUTBACK> and
30L<perlcall>.
31
32=for apidoc Ams||dSP
33Declares a local copy of perl's stack pointer for the XSUB, available via
34the C<SP> macro.  See C<SP>.
35
36=for apidoc Ams||dMARK
37Declare a stack marker variable, C<mark>, for the XSUB.  See C<MARK> and
38C<dORIGMARK>.
39
40=for apidoc Ams||dORIGMARK
41Saves the original stack mark for the XSUB.  See C<ORIGMARK>.
42
43=for apidoc AmU||ORIGMARK
44The original stack mark for the XSUB.  See C<dORIGMARK>.
45
46=for apidoc Ams||SPAGAIN
47Refetch the stack pointer.  Used after a callback.  See L<perlcall>.
48
49=cut
50*/
51
52#define SP sp
53#define MARK mark
54#define TARG targ
55
56#define PUSHMARK(p) if (++PL_markstack_ptr == PL_markstack_max) \
57                        markstack_grow();                       \
58                    *PL_markstack_ptr = (p) - PL_stack_base
59
60#define TOPMARK         (*PL_markstack_ptr)
61#define POPMARK         (*PL_markstack_ptr--)
62
63#define djSP            register SV **sp = PL_stack_sp
64#define dSP             dTHR; djSP
65#define dMARK           register SV **mark = PL_stack_base + POPMARK
66#define dORIGMARK       I32 origmark = mark - PL_stack_base
67#define SETORIGMARK     origmark = mark - PL_stack_base
68#define ORIGMARK        (PL_stack_base + origmark)
69
70#define SPAGAIN         sp = PL_stack_sp
71#define MSPAGAIN        sp = PL_stack_sp; mark = ORIGMARK
72
73#define GETTARGETSTACKED targ = (PL_op->op_flags & OPf_STACKED ? POPs : PAD_SV(PL_op->op_targ))
74#define dTARGETSTACKED SV * GETTARGETSTACKED
75
76#define GETTARGET targ = PAD_SV(PL_op->op_targ)
77#define dTARGET SV * GETTARGET
78
79#define GETATARGET targ = (PL_op->op_flags & OPf_STACKED ? sp[-1] : PAD_SV(PL_op->op_targ))
80#define dATARGET SV * GETATARGET
81
82#define dTARG SV *targ
83
84#define NORMAL PL_op->op_next
85#define DIE return Perl_die
86
87/*
88=for apidoc Ams||PUTBACK
89Closing bracket for XSUB arguments.  This is usually handled by C<xsubpp>.
90See C<PUSHMARK> and L<perlcall> for other uses.
91
92=for apidoc Amn|SV*|POPs
93Pops an SV off the stack.
94
95=for apidoc Amn|char*|POPp
96Pops a string off the stack.
97
98=for apidoc Amn|NV|POPn
99Pops a double off the stack.
100
101=for apidoc Amn|IV|POPi
102Pops an integer off the stack.
103
104=for apidoc Amn|long|POPl
105Pops a long off the stack.
106
107=cut
108*/
109
110#define PUTBACK         PL_stack_sp = sp
111#define RETURN          return PUTBACK, NORMAL
112#define RETURNOP(o)     return PUTBACK, o
113#define RETURNX(x)      return x, PUTBACK, NORMAL
114
115#define POPs            (*sp--)
116#define POPp            (SvPVx(POPs, PL_na))            /* deprecated */
117#define POPpx           (SvPVx(POPs, n_a))
118#define POPn            (SvNVx(POPs))
119#define POPi            ((IV)SvIVx(POPs))
120#define POPu            ((UV)SvUVx(POPs))
121#define POPl            ((long)SvIVx(POPs))
122#define POPul           ((unsigned long)SvIVx(POPs))
123#ifdef HAS_QUAD
124#define POPq            ((Quad_t)SvIVx(POPs))
125#define POPuq           ((Uquad_t)SvUVx(POPs))
126#endif
127
128#define TOPs            (*sp)
129#define TOPp            (SvPV(TOPs, PL_na))             /* deprecated */
130#define TOPpx           (SvPV(TOPs, n_a))
131#define TOPn            (SvNV(TOPs))
132#define TOPi            ((IV)SvIV(TOPs))
133#define TOPu            ((UV)SvUV(TOPs))
134#define TOPl            ((long)SvIV(TOPs))
135#define TOPul           ((unsigned long)SvUV(TOPs))
136#ifdef HAS_QUAD
137#define TOPq            ((Quad_t)SvIV(TOPs))
138#define TOPuq           ((Uquad_t)SvUV(TOPs))
139#endif
140
141/* Go to some pains in the rare event that we must extend the stack. */
142
143/*
144=for apidoc Am|void|EXTEND|SP|int nitems
145Used to extend the argument stack for an XSUB's return values. Once
146used, guarrantees that there is room for at least C<nitems> to be pushed
147onto the stack.
148
149=for apidoc Am|void|PUSHs|SV* sv
150Push an SV onto the stack.  The stack must have room for this element.
151Does not handle 'set' magic.  See C<XPUSHs>.
152
153=for apidoc Am|void|PUSHp|char* str|STRLEN len
154Push a string onto the stack.  The stack must have room for this element.
155The C<len> indicates the length of the string.  Handles 'set' magic.  See
156C<XPUSHp>.
157
158=for apidoc Am|void|PUSHn|NV nv
159Push a double onto the stack.  The stack must have room for this element.
160Handles 'set' magic.  See C<XPUSHn>.
161
162=for apidoc Am|void|PUSHi|IV iv
163Push an integer onto the stack.  The stack must have room for this element.
164Handles 'set' magic.  See C<XPUSHi>.
165
166=for apidoc Am|void|PUSHu|UV uv
167Push an unsigned integer onto the stack.  The stack must have room for this
168element.  See C<XPUSHu>.
169
170=for apidoc Am|void|XPUSHs|SV* sv
171Push an SV onto the stack, extending the stack if necessary.  Does not
172handle 'set' magic.  See C<PUSHs>.
173
174=for apidoc Am|void|XPUSHp|char* str|STRLEN len
175Push a string onto the stack, extending the stack if necessary.  The C<len>
176indicates the length of the string.  Handles 'set' magic.  See
177C<PUSHp>.
178
179=for apidoc Am|void|XPUSHn|NV nv
180Push a double onto the stack, extending the stack if necessary.  Handles
181'set' magic.  See C<PUSHn>.
182
183=for apidoc Am|void|XPUSHi|IV iv
184Push an integer onto the stack, extending the stack if necessary.  Handles
185'set' magic. See C<PUSHi>.
186
187=for apidoc Am|void|XPUSHu|UV uv
188Push an unsigned integer onto the stack, extending the stack if necessary.
189See C<PUSHu>.
190
191=cut
192*/
193
194#define EXTEND(p,n)     STMT_START { if (PL_stack_max - p < (n)) {              \
195                            sp = stack_grow(sp,p, (int) (n));           \
196                        } } STMT_END
197
198/* Same thing, but update mark register too. */
199#define MEXTEND(p,n)    STMT_START {if (PL_stack_max - p < (n)) {               \
200                            int markoff = mark - PL_stack_base;         \
201                            sp = stack_grow(sp,p,(int) (n));            \
202                            mark = PL_stack_base + markoff;             \
203                        } } STMT_END
204
205#define PUSHs(s)        (*++sp = (s))
206#define PUSHTARG        STMT_START { SvSETMAGIC(TARG); PUSHs(TARG); } STMT_END
207#define PUSHp(p,l)      STMT_START { sv_setpvn(TARG, (p), (l)); PUSHTARG; } STMT_END
208#define PUSHn(n)        STMT_START { sv_setnv(TARG, (NV)(n)); PUSHTARG; } STMT_END
209#define PUSHi(i)        STMT_START { sv_setiv(TARG, (IV)(i)); PUSHTARG; } STMT_END
210#define PUSHu(u)        STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
211
212#define XPUSHs(s)       STMT_START { EXTEND(sp,1); (*++sp = (s)); } STMT_END
213#define XPUSHTARG       STMT_START { SvSETMAGIC(TARG); XPUSHs(TARG); } STMT_END
214#define XPUSHp(p,l)     STMT_START { sv_setpvn(TARG, (p), (l)); XPUSHTARG; } STMT_END
215#define XPUSHn(n)       STMT_START { sv_setnv(TARG, (NV)(n)); XPUSHTARG; } STMT_END
216#define XPUSHi(i)       STMT_START { sv_setiv(TARG, (IV)(i)); XPUSHTARG; } STMT_END
217#define XPUSHu(u)       STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
218#define XPUSHundef      STMT_START { SvOK_off(TARG); XPUSHs(TARG); } STMT_END
219
220#define SETs(s)         (*sp = s)
221#define SETTARG         STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END
222#define SETp(p,l)       STMT_START { sv_setpvn(TARG, (p), (l)); SETTARG; } STMT_END
223#define SETn(n)         STMT_START { sv_setnv(TARG, (NV)(n)); SETTARG; } STMT_END
224#define SETi(i)         STMT_START { sv_setiv(TARG, (IV)(i)); SETTARG; } STMT_END
225#define SETu(u)         STMT_START { sv_setuv(TARG, (UV)(u)); SETTARG; } STMT_END
226
227#define dTOPss          SV *sv = TOPs
228#define dPOPss          SV *sv = POPs
229#define dTOPnv          NV value = TOPn
230#define dPOPnv          NV value = POPn
231#define dTOPiv          IV value = TOPi
232#define dPOPiv          IV value = POPi
233#define dTOPuv          UV value = TOPu
234#define dPOPuv          UV value = POPu
235#ifdef HAS_QUAD
236#define dTOPqv          Quad_t value = TOPu
237#define dPOPqv          Quad_t value = POPu
238#define dTOPuqv         Uquad_t value = TOPuq
239#define dPOPuqv         Uquad_t value = POPuq
240#endif
241
242#define dPOPXssrl(X)    SV *right = POPs; SV *left = CAT2(X,s)
243#define dPOPXnnrl(X)    NV right = POPn; NV left = CAT2(X,n)
244#define dPOPXiirl(X)    IV right = POPi; IV left = CAT2(X,i)
245
246#define USE_LEFT(sv) \
247        (SvOK(sv) || SvGMAGICAL(sv) || !(PL_op->op_flags & OPf_STACKED))
248#define dPOPXnnrl_ul(X) \
249    NV right = POPn;                            \
250    SV *leftsv = CAT2(X,s);                             \
251    NV left = USE_LEFT(leftsv) ? SvNV(leftsv) : 0.0
252#define dPOPXiirl_ul(X) \
253    IV right = POPi;                                    \
254    SV *leftsv = CAT2(X,s);                             \
255    IV left = USE_LEFT(leftsv) ? SvIV(leftsv) : 0
256
257#define dPOPPOPssrl     dPOPXssrl(POP)
258#define dPOPPOPnnrl     dPOPXnnrl(POP)
259#define dPOPPOPnnrl_ul  dPOPXnnrl_ul(POP)
260#define dPOPPOPiirl     dPOPXiirl(POP)
261#define dPOPPOPiirl_ul  dPOPXiirl_ul(POP)
262
263#define dPOPTOPssrl     dPOPXssrl(TOP)
264#define dPOPTOPnnrl     dPOPXnnrl(TOP)
265#define dPOPTOPnnrl_ul  dPOPXnnrl_ul(TOP)
266#define dPOPTOPiirl     dPOPXiirl(TOP)
267#define dPOPTOPiirl_ul  dPOPXiirl_ul(TOP)
268
269#define RETPUSHYES      RETURNX(PUSHs(&PL_sv_yes))
270#define RETPUSHNO       RETURNX(PUSHs(&PL_sv_no))
271#define RETPUSHUNDEF    RETURNX(PUSHs(&PL_sv_undef))
272
273#define RETSETYES       RETURNX(SETs(&PL_sv_yes))
274#define RETSETNO        RETURNX(SETs(&PL_sv_no))
275#define RETSETUNDEF     RETURNX(SETs(&PL_sv_undef))
276
277#define ARGTARG         PL_op->op_targ
278
279    /* See OPpTARGET_MY: */
280#define MAXARG          (PL_op->op_private & 15)
281
282#define SWITCHSTACK(f,t) \
283    STMT_START {                                                        \
284        AvFILLp(f) = sp - PL_stack_base;                                \
285        PL_stack_base = AvARRAY(t);                                     \
286        PL_stack_max = PL_stack_base + AvMAX(t);                        \
287        sp = PL_stack_sp = PL_stack_base + AvFILLp(t);                  \
288        PL_curstack = t;                                                \
289    } STMT_END
290
291#define EXTEND_MORTAL(n) \
292    STMT_START {                                                        \
293        if (PL_tmps_ix + (n) >= PL_tmps_max)                            \
294            tmps_grow(n);                                               \
295    } STMT_END
296
297#define AMGf_noright    1
298#define AMGf_noleft     2
299#define AMGf_assign     4
300#define AMGf_unary      8
301
302#define tryAMAGICbinW(meth,assign,set) STMT_START { \
303          if (PL_amagic_generation) { \
304            SV* tmpsv; \
305            SV* right= *(sp); SV* left= *(sp-1);\
306            if ((SvAMAGIC(left)||SvAMAGIC(right))&&\
307                (tmpsv=amagic_call(left, \
308                                   right, \
309                                   CAT2(meth,_amg), \
310                                   (assign)? AMGf_assign: 0))) {\
311               SPAGAIN; \
312               (void)POPs; set(tmpsv); RETURN; } \
313          } \
314        } STMT_END
315
316#define tryAMAGICbin(meth,assign) tryAMAGICbinW(meth,assign,SETsv)
317#define tryAMAGICbinSET(meth,assign) tryAMAGICbinW(meth,assign,SETs)
318
319#define AMG_CALLun(sv,meth) amagic_call(sv,&PL_sv_undef,  \
320                                        CAT2(meth,_amg),AMGf_noright | AMGf_unary)
321#define AMG_CALLbinL(left,right,meth) \
322            amagic_call(left,right,CAT2(meth,_amg),AMGf_noright)
323
324#define tryAMAGICunW(meth,set,shift,ret) STMT_START { \
325          if (PL_amagic_generation) { \
326            SV* tmpsv; \
327            SV* arg= sp[shift]; \
328          am_again: \
329            if ((SvAMAGIC(arg))&&\
330                (tmpsv=AMG_CALLun(arg,meth))) {\
331               SPAGAIN; if (shift) sp += shift; \
332               set(tmpsv); ret; } \
333          } \
334        } STMT_END
335
336#define FORCE_SETs(sv) STMT_START { sv_setsv(TARG, (sv)); SETTARG; } STMT_END
337
338#define tryAMAGICun(meth)       tryAMAGICunW(meth,SETsvUN,0,RETURN)
339#define tryAMAGICunSET(meth)    tryAMAGICunW(meth,SETs,0,RETURN)
340#define tryAMAGICunTARGET(meth, shift)                                  \
341        { dSP; sp--;    /* get TARGET from below PL_stack_sp */         \
342            { dTARGETSTACKED;                                           \
343                { dSP; tryAMAGICunW(meth,FORCE_SETs,shift,RETURN);}}}
344
345#define setAGAIN(ref) sv = arg = ref;                                   \
346  if (!SvROK(ref))                                                      \
347      Perl_croak(aTHX_ "Overloaded dereference did not return a reference");    \
348  goto am_again;
349
350#define tryAMAGICunDEREF(meth) tryAMAGICunW(meth,setAGAIN,0,(void)0)
351
352#define opASSIGN (PL_op->op_flags & OPf_STACKED)
353#define SETsv(sv)       STMT_START {                                    \
354                if (opASSIGN || (SvFLAGS(TARG) & SVs_PADMY))            \
355                   { sv_setsv(TARG, (sv)); SETTARG; }                   \
356                else SETs(sv); } STMT_END
357
358#define SETsvUN(sv)     STMT_START {                                    \
359                if (SvFLAGS(TARG) & SVs_PADMY)          \
360                   { sv_setsv(TARG, (sv)); SETTARG; }                   \
361                else SETs(sv); } STMT_END
362
363/* newSVsv does not behave as advertised, so we copy missing
364 * information by hand */
365
366/* SV* ref causes confusion with the member variable
367   changed SV* ref to SV* tmpRef */
368#define RvDEEPCP(rv) STMT_START { SV* tmpRef=SvRV(rv);      \
369  if (SvREFCNT(tmpRef)>1) {                 \
370    SvREFCNT_dec(tmpRef);                   \
371    SvRV(rv)=AMG_CALLun(rv,copy);        \
372  } } STMT_END
Note: See TracBrowser for help on using the repository browser.