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