File::Spec bugs (spotted by Hack Kampbjorn <hack@hackdata.com>)
[p5sagit/p5-mst-13.2.git] / pp.h
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
22 Stack pointer.  This is usually handled by C<xsubpp>.  See C<dSP> and
23 C<SPAGAIN>.
24
25 =for apidoc AmU||MARK
26 Stack marker variable for the XSUB.  See C<dMARK>.
27
28 =for apidoc Ams||PUSHMARK
29 Opening bracket for arguments on a callback.  See C<PUTBACK> and
30 L<perlcall>.
31
32 =for apidoc Ams||dSP
33 Declares a local copy of perl's stack pointer for the XSUB, available via
34 the C<SP> macro.  See C<SP>.
35
36 =for apidoc Ams||dMARK
37 Declare a stack marker variable, C<mark>, for the XSUB.  See C<MARK> and
38 C<dORIGMARK>.
39
40 =for apidoc Ams||dORIGMARK
41 Saves the original stack mark for the XSUB.  See C<ORIGMARK>.
42
43 =for apidoc AmU||ORIGMARK
44 The original stack mark for the XSUB.  See C<dORIGMARK>.
45
46 =for apidoc Ams||SPAGAIN
47 Refetch 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
89 Closing bracket for XSUB arguments.  This is usually handled by C<xsubpp>.
90 See C<PUSHMARK> and L<perlcall> for other uses.
91
92 =for apidoc Amn|SV*|POPs
93 Pops an SV off the stack.
94
95 =for apidoc Amn|char*|POPp
96 Pops a string off the stack.
97
98 =for apidoc Amn|NV|POPn
99 Pops a double off the stack.
100
101 =for apidoc Amn|IV|POPi
102 Pops an integer off the stack.
103
104 =for apidoc Amn|long|POPl
105 Pops 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
145 Used to extend the argument stack for an XSUB's return values. Once
146 used, guarrantees that there is room for at least C<nitems> to be pushed
147 onto the stack.
148
149 =for apidoc Am|void|PUSHs|SV* sv
150 Push an SV onto the stack.  The stack must have room for this element. 
151 Does not handle 'set' magic.  See C<XPUSHs>.
152
153 =for apidoc Am|void|PUSHp|char* str|STRLEN len
154 Push a string onto the stack.  The stack must have room for this element.
155 The C<len> indicates the length of the string.  Handles 'set' magic.  See
156 C<XPUSHp>.
157
158 =for apidoc Am|void|PUSHn|NV nv
159 Push a double onto the stack.  The stack must have room for this element.
160 Handles 'set' magic.  See C<XPUSHn>.
161
162 =for apidoc Am|void|PUSHi|IV iv
163 Push an integer onto the stack.  The stack must have room for this element.
164 Handles 'set' magic.  See C<XPUSHi>.
165
166 =for apidoc Am|void|PUSHu|UV uv
167 Push an unsigned integer onto the stack.  The stack must have room for this
168 element.  See C<XPUSHu>.
169
170 =for apidoc Am|void|XPUSHs|SV* sv
171 Push an SV onto the stack, extending the stack if necessary.  Does not
172 handle 'set' magic.  See C<PUSHs>.
173
174 =for apidoc Am|void|XPUSHp|char* str|STRLEN len
175 Push a string onto the stack, extending the stack if necessary.  The C<len>
176 indicates the length of the string.  Handles 'set' magic.  See
177 C<PUSHp>.
178
179 =for apidoc Am|void|XPUSHn|NV nv
180 Push 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
184 Push 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
188 Push an unsigned integer onto the stack, extending the stack if necessary. 
189 See 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