1 /* cop.h 2 * 3 * Copyright (c) 1991-2001, 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 struct cop { 11 BASEOP 12 char * cop_label; /* label for this construct */ 13 #ifdef USE_ITHREADS 14 char * cop_stashpv; /* package line was compiled in */ 15 char * cop_file; /* file name the following line # is from */ 16 #else 17 HV * cop_stash; /* package line was compiled in */ 18 GV * cop_filegv; /* file the following line # is from */ 19 #endif 20 U32 cop_seq; /* parse sequence number */ 21 I32 cop_arybase; /* array base this line was compiled with */ 22 line_t cop_line; /* line # of this command */ 23 SV * cop_warnings; /* lexical warnings bitmask */ 24 }; 25 26 #define Nullcop Null(COP*) 27 28 #ifdef USE_ITHREADS 29 # define CopFILE(c) ((c)->cop_file) 30 # define CopFILEGV(c) (CopFILE(c) \ 31 ? gv_fetchfile(CopFILE(c)) : Nullgv) 32 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) 33 # define CopFILESV(c) (CopFILE(c) \ 34 ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) 35 # define CopFILEAV(c) (CopFILE(c) \ 36 ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) 37 # define CopSTASHPV(c) ((c)->cop_stashpv) 38 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch)) 39 # define CopSTASH(c) (CopSTASHPV(c) \ 40 ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv) 41 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch) 42 # define CopSTASH_eq(c,hv) ((hv) \ 43 && (CopSTASHPV(c) == HvNAME(hv) \ 44 || (CopSTASHPV(c) && HvNAME(hv) \ 45 && strEQ(CopSTASHPV(c), HvNAME(hv))))) 46 #else 47 # define CopFILEGV(c) ((c)->cop_filegv) 48 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) 49 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) 50 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) 51 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) 52 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) 53 # define CopSTASH(c) ((c)->cop_stash) 54 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) 55 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) 56 /* cop_stash is not refcounted */ 57 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) 58 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) 59 #endif /* USE_ITHREADS */ 60 61 #define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv)) 62 #define CopLINE(c) ((c)->cop_line) 63 #define CopLINE_inc(c) (++CopLINE(c)) 64 #define CopLINE_dec(c) (--CopLINE(c)) 65 #define CopLINE_set(c,l) (CopLINE(c) = (l)) 66 67 /* 68 * Here we have some enormously heavy (or at least ponderous) wizardry. 69 */ 70 71 /* subroutine context */ 72 struct block_sub { 73 CV * cv; 74 GV * gv; 75 GV * dfoutgv; 76 #ifndef USE_THREADS 77 AV * savearray; 78 #endif /* USE_THREADS */ 79 AV * argarray; 80 U16 olddepth; 81 U8 hasargs; 82 U8 lval; /* XXX merge lval and hasargs? */ 83 SV ** oldcurpad; 84 }; 85 86 #define PUSHSUB(cx) \ 87 cx->blk_sub.cv = cv; \ 88 cx->blk_sub.olddepth = CvDEPTH(cv); \ 89 cx->blk_sub.hasargs = hasargs; \ 90 cx->blk_sub.lval = PL_op->op_private & \ 91 (OPpLVAL_INTRO|OPpENTERSUB_INARGS); 92 93 #define PUSHFORMAT(cx) \ 94 cx->blk_sub.cv = cv; \ 95 cx->blk_sub.gv = gv; \ 96 cx->blk_sub.hasargs = 0; \ 97 cx->blk_sub.dfoutgv = PL_defoutgv; \ 98 (void)SvREFCNT_inc(cx->blk_sub.dfoutgv) 99 100 #ifdef USE_THREADS 101 # define POP_SAVEARRAY() NOOP 102 #else 103 # define POP_SAVEARRAY() \ 104 STMT_START { \ 105 SvREFCNT_dec(GvAV(PL_defgv)); \ 106 GvAV(PL_defgv) = cx->blk_sub.savearray; \ 107 } STMT_END 108 #endif /* USE_THREADS */ 109 110 /* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't 111 * leave any (a fast av_clear(ary), basically) */ 112 #define CLEAR_ARGARRAY(ary) \ 113 STMT_START { \ 114 AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary); \ 115 SvPVX(ary) = (char*)AvALLOC(ary); \ 116 AvFILLp(ary) = -1; \ 117 } STMT_END 118 119 #define POPSUB(cx,sv) \ 120 STMT_START { \ 121 if (cx->blk_sub.hasargs) { \ 122 POP_SAVEARRAY(); \ 123 /* abandon @_ if it got reified */ \ 124 if (AvREAL(cx->blk_sub.argarray)) { \ 125 SSize_t fill = AvFILLp(cx->blk_sub.argarray); \ 126 SvREFCNT_dec(cx->blk_sub.argarray); \ 127 cx->blk_sub.argarray = newAV(); \ 128 av_extend(cx->blk_sub.argarray, fill); \ 129 AvFLAGS(cx->blk_sub.argarray) = AVf_REIFY; \ 130 cx->blk_sub.oldcurpad[0] = (SV*)cx->blk_sub.argarray; \ 131 } \ 132 else { \ 133 CLEAR_ARGARRAY(cx->blk_sub.argarray); \ 134 } \ 135 } \ 136 sv = (SV*)cx->blk_sub.cv; \ 137 if (sv && (CvDEPTH((CV*)sv) = cx->blk_sub.olddepth)) \ 138 sv = Nullsv; \ 139 } STMT_END 140 141 #define LEAVESUB(sv) \ 142 STMT_START { \ 143 if (sv) \ 144 SvREFCNT_dec(sv); \ 145 } STMT_END 146 147 #define POPFORMAT(cx) \ 148 setdefout(cx->blk_sub.dfoutgv); \ 149 SvREFCNT_dec(cx->blk_sub.dfoutgv); 150 151 /* eval context */ 152 struct block_eval { 153 I32 old_in_eval; 154 I32 old_op_type; 155 SV * old_namesv; 156 OP * old_eval_root; 157 SV * cur_text; 158 }; 159 160 #define PUSHEVAL(cx,n,fgv) \ 161 STMT_START { \ 162 cx->blk_eval.old_in_eval = PL_in_eval; \ 163 cx->blk_eval.old_op_type = PL_op->op_type; \ 164 cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : Nullsv); \ 165 cx->blk_eval.old_eval_root = PL_eval_root; \ 166 cx->blk_eval.cur_text = PL_linestr; \ 167 } STMT_END 168 169 #define POPEVAL(cx) \ 170 STMT_START { \ 171 PL_in_eval = cx->blk_eval.old_in_eval; \ 172 optype = cx->blk_eval.old_op_type; \ 173 PL_eval_root = cx->blk_eval.old_eval_root; \ 174 if (cx->blk_eval.old_namesv) \ 175 sv_2mortal(cx->blk_eval.old_namesv); \ 176 } STMT_END 177 178 /* loop context */ 179 struct block_loop { 180 char * label; 181 I32 resetsp; 182 OP * redo_op; 183 OP * next_op; 184 OP * last_op; 185 #ifdef USE_ITHREADS 186 void * iterdata; 187 SV ** oldcurpad; 188 #else 189 SV ** itervar; 190 #endif 191 SV * itersave; 192 SV * iterlval; 193 AV * iterary; 194 IV iterix; 195 IV itermax; 196 }; 197 198 #ifdef USE_ITHREADS 199 # define CxITERVAR(c) \ 200 ((c)->blk_loop.iterdata \ 201 ? (CxPADLOOP(cx) \ 202 ? &((c)->blk_loop.oldcurpad)[(PADOFFSET)(c)->blk_loop.iterdata] \ 203 : &GvSV((GV*)(c)->blk_loop.iterdata)) \ 204 : (SV**)NULL) 205 # define CX_ITERDATA_SET(cx,idata) \ 206 cx->blk_loop.oldcurpad = PL_curpad; \ 207 if ((cx->blk_loop.iterdata = (idata))) \ 208 cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx)); 209 #else 210 # define CxITERVAR(c) ((c)->blk_loop.itervar) 211 # define CX_ITERDATA_SET(cx,ivar) \ 212 if ((cx->blk_loop.itervar = (SV**)(ivar))) \ 213 cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx)); 214 #endif 215 216 #define PUSHLOOP(cx, dat, s) \ 217 cx->blk_loop.label = PL_curcop->cop_label; \ 218 cx->blk_loop.resetsp = s - PL_stack_base; \ 219 cx->blk_loop.redo_op = cLOOP->op_redoop; \ 220 cx->blk_loop.next_op = cLOOP->op_nextop; \ 221 cx->blk_loop.last_op = cLOOP->op_lastop; \ 222 cx->blk_loop.iterlval = Nullsv; \ 223 cx->blk_loop.iterary = Nullav; \ 224 cx->blk_loop.iterix = -1; \ 225 CX_ITERDATA_SET(cx,dat); 226 227 #define POPLOOP(cx) \ 228 SvREFCNT_dec(cx->blk_loop.iterlval); \ 229 if (CxITERVAR(cx)) { \ 230 SV **s_v_p = CxITERVAR(cx); \ 231 sv_2mortal(*s_v_p); \ 232 *s_v_p = cx->blk_loop.itersave; \ 233 } \ 234 if (cx->blk_loop.iterary && cx->blk_loop.iterary != PL_curstack)\ 235 SvREFCNT_dec(cx->blk_loop.iterary); 236 237 /* context common to subroutines, evals and loops */ 238 struct block { 239 I32 blku_oldsp; /* stack pointer to copy stuff down to */ 240 COP * blku_oldcop; /* old curcop pointer */ 241 I32 blku_oldretsp; /* return stack index */ 242 I32 blku_oldmarksp; /* mark stack index */ 243 I32 blku_oldscopesp; /* scope stack index */ 244 PMOP * blku_oldpm; /* values of pattern match vars */ 245 U8 blku_gimme; /* is this block running in list context? */ 246 247 union { 248 struct block_sub blku_sub; 249 struct block_eval blku_eval; 250 struct block_loop blku_loop; 251 } blk_u; 252 }; 253 #define blk_oldsp cx_u.cx_blk.blku_oldsp 254 #define blk_oldcop cx_u.cx_blk.blku_oldcop 255 #define blk_oldretsp cx_u.cx_blk.blku_oldretsp 256 #define blk_oldmarksp cx_u.cx_blk.blku_oldmarksp 257 #define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp 258 #define blk_oldpm cx_u.cx_blk.blku_oldpm 259 #define blk_gimme cx_u.cx_blk.blku_gimme 260 #define blk_sub cx_u.cx_blk.blk_u.blku_sub 261 #define blk_eval cx_u.cx_blk.blk_u.blku_eval 262 #define blk_loop cx_u.cx_blk.blk_u.blku_loop 263 264 /* Enter a block. */ 265 #define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix], \ 266 cx->cx_type = t, \ 267 cx->blk_oldsp = sp - PL_stack_base, \ 268 cx->blk_oldcop = PL_curcop, \ 269 cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack, \ 270 cx->blk_oldscopesp = PL_scopestack_ix, \ 271 cx->blk_oldretsp = PL_retstack_ix, \ 272 cx->blk_oldpm = PL_curpm, \ 273 cx->blk_gimme = gimme; \ 274 DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n", \ 275 (long)cxstack_ix, PL_block_type[CxTYPE(cx)]); ) 276 277 /* Exit a block (RETURN and LAST). */ 278 #define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \ 279 newsp = PL_stack_base + cx->blk_oldsp, \ 280 PL_curcop = cx->blk_oldcop, \ 281 PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \ 282 PL_scopestack_ix = cx->blk_oldscopesp, \ 283 PL_retstack_ix = cx->blk_oldretsp, \ 284 pm = cx->blk_oldpm, \ 285 gimme = cx->blk_gimme; \ 286 DEBUG_l( PerlIO_printf(Perl_debug_log, "Leaving block %ld, type %s\n", \ 287 (long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); ) 288 289 /* Continue a block elsewhere (NEXT and REDO). */ 290 #define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \ 291 PL_stack_sp = PL_stack_base + cx->blk_oldsp, \ 292 PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp, \ 293 PL_scopestack_ix = cx->blk_oldscopesp, \ 294 PL_retstack_ix = cx->blk_oldretsp, \ 295 PL_curpm = cx->blk_oldpm 296 297 /* substitution context */ 298 struct subst { 299 I32 sbu_iters; 300 I32 sbu_maxiters; 301 I32 sbu_rflags; 302 I32 sbu_oldsave; 303 bool sbu_once; 304 bool sbu_rxtainted; 305 char * sbu_orig; 306 SV * sbu_dstr; 307 SV * sbu_targ; 308 char * sbu_s; 309 char * sbu_m; 310 char * sbu_strend; 311 void * sbu_rxres; 312 REGEXP * sbu_rx; 313 }; 314 #define sb_iters cx_u.cx_subst.sbu_iters 315 #define sb_maxiters cx_u.cx_subst.sbu_maxiters 316 #define sb_rflags cx_u.cx_subst.sbu_rflags 317 #define sb_oldsave cx_u.cx_subst.sbu_oldsave 318 #define sb_once cx_u.cx_subst.sbu_once 319 #define sb_rxtainted cx_u.cx_subst.sbu_rxtainted 320 #define sb_orig cx_u.cx_subst.sbu_orig 321 #define sb_dstr cx_u.cx_subst.sbu_dstr 322 #define sb_targ cx_u.cx_subst.sbu_targ 323 #define sb_s cx_u.cx_subst.sbu_s 324 #define sb_m cx_u.cx_subst.sbu_m 325 #define sb_strend cx_u.cx_subst.sbu_strend 326 #define sb_rxres cx_u.cx_subst.sbu_rxres 327 #define sb_rx cx_u.cx_subst.sbu_rx 328 329 #define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix], \ 330 cx->sb_iters = iters, \ 331 cx->sb_maxiters = maxiters, \ 332 cx->sb_rflags = r_flags, \ 333 cx->sb_oldsave = oldsave, \ 334 cx->sb_once = once, \ 335 cx->sb_rxtainted = rxtainted, \ 336 cx->sb_orig = orig, \ 337 cx->sb_dstr = dstr, \ 338 cx->sb_targ = targ, \ 339 cx->sb_s = s, \ 340 cx->sb_m = m, \ 341 cx->sb_strend = strend, \ 342 cx->sb_rxres = Null(void*), \ 343 cx->sb_rx = rx, \ 344 cx->cx_type = CXt_SUBST; \ 345 rxres_save(&cx->sb_rxres, rx) 346 347 #define POPSUBST(cx) cx = &cxstack[cxstack_ix--]; \ 348 rxres_free(&cx->sb_rxres) 349 350 struct context { 351 U32 cx_type; /* what kind of context this is */ 352 union { 353 struct block cx_blk; 354 struct subst cx_subst; 355 } cx_u; 356 }; 357 358 #define CXTYPEMASK 0xff 359 #define CXt_NULL 0 360 #define CXt_SUB 1 361 #define CXt_EVAL 2 362 #define CXt_LOOP 3 363 #define CXt_SUBST 4 364 #define CXt_BLOCK 5 365 #define CXt_FORMAT 6 366 367 /* private flags for CXt_EVAL */ 368 #define CXp_REAL 0x00000100 /* truly eval'', not a lookalike */ 369 #define CXp_TRYBLOCK 0x00000200 /* eval{}, not eval'' or similar */ 370 371 #ifdef USE_ITHREADS 372 /* private flags for CXt_LOOP */ 373 # define CXp_PADVAR 0x00000100 /* itervar lives on pad, iterdata 374 has pad offset; if not set, 375 iterdata holds GV* */ 376 # define CxPADLOOP(c) (((c)->cx_type & (CXt_LOOP|CXp_PADVAR)) \ 377 == (CXt_LOOP|CXp_PADVAR)) 378 #endif 379 380 #define CxTYPE(c) ((c)->cx_type & CXTYPEMASK) 381 #define CxREALEVAL(c) (((c)->cx_type & (CXt_EVAL|CXp_REAL)) \ 382 == (CXt_EVAL|CXp_REAL)) 383 #define CxTRYBLOCK(c) (((c)->cx_type & (CXt_EVAL|CXp_TRYBLOCK)) \ 384 == (CXt_EVAL|CXp_TRYBLOCK)) 385 386 #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc())) 387 388 /* "gimme" values */ 389 390 /* 391 =for apidoc AmU||G_SCALAR 392 Used to indicate scalar context. See C<GIMME_V>, C<GIMME>, and 393 L<perlcall>. 394 395 =for apidoc AmU||G_ARRAY 396 Used to indicate list context. See C<GIMME_V>, C<GIMME> and 397 L<perlcall>. 398 399 =for apidoc AmU||G_VOID 400 Used to indicate void context. See C<GIMME_V> and L<perlcall>. 401 402 =for apidoc AmU||G_DISCARD 403 Indicates that arguments returned from a callback should be discarded. See 404 L<perlcall>. 405 406 =for apidoc AmU||G_EVAL 407 408 Used to force a Perl C<eval> wrapper around a callback. See 409 L<perlcall>. 410 411 =for apidoc AmU||G_NOARGS 412 413 Indicates that no arguments are being sent to a callback. See 414 L<perlcall>. 415 416 =cut 417 */ 418 419 #define G_SCALAR 0 420 #define G_ARRAY 1 421 #define G_VOID 128 /* skip this bit when adding flags below */ 422 423 /* extra flags for Perl_call_* routines */ 424 #define G_DISCARD 2 /* Call FREETMPS. */ 425 #define G_EVAL 4 /* Assume eval {} around subroutine call. */ 426 #define G_NOARGS 8 /* Don't construct a @_ array. */ 427 #define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */ 428 #define G_NODEBUG 32 /* Disable debugging at toplevel. */ 429 #define G_METHOD 64 /* Calling method. */ 430 431 /* flag bits for PL_in_eval */ 432 #define EVAL_NULL 0 /* not in an eval */ 433 #define EVAL_INEVAL 1 /* some enclosing scope is an eval */ 434 #define EVAL_WARNONLY 2 /* used by yywarn() when calling yyerror() */ 435 #define EVAL_KEEPERR 4 /* set by Perl_call_sv if G_KEEPERR */ 436 #define EVAL_INREQUIRE 8 /* The code is being required. */ 437 438 /* Support for switching (stack and block) contexts. 439 * This ensures magic doesn't invalidate local stack and cx pointers. 440 */ 441 442 #define PERLSI_UNKNOWN -1 443 #define PERLSI_UNDEF 0 444 #define PERLSI_MAIN 1 445 #define PERLSI_MAGIC 2 446 #define PERLSI_SORT 3 447 #define PERLSI_SIGNAL 4 448 #define PERLSI_OVERLOAD 5 449 #define PERLSI_DESTROY 6 450 #define PERLSI_WARNHOOK 7 451 #define PERLSI_DIEHOOK 8 452 #define PERLSI_REQUIRE 9 453 454 struct stackinfo { 455 AV * si_stack; /* stack for current runlevel */ 456 PERL_CONTEXT * si_cxstack; /* context stack for runlevel */ 457 I32 si_cxix; /* current context index */ 458 I32 si_cxmax; /* maximum allocated index */ 459 I32 si_type; /* type of runlevel */ 460 struct stackinfo * si_prev; 461 struct stackinfo * si_next; 462 I32 si_markoff; /* offset where markstack begins for us. 463 * currently used only with DEBUGGING, 464 * but not #ifdef-ed for bincompat */ 465 }; 466 467 typedef struct stackinfo PERL_SI; 468 469 #define cxstack (PL_curstackinfo->si_cxstack) 470 #define cxstack_ix (PL_curstackinfo->si_cxix) 471 #define cxstack_max (PL_curstackinfo->si_cxmax) 472 473 #ifdef DEBUGGING 474 # define SET_MARK_OFFSET \ 475 PL_curstackinfo->si_markoff = PL_markstack_ptr - PL_markstack 476 #else 477 # define SET_MARK_OFFSET NOOP 478 #endif 479 480 #define PUSHSTACKi(type) \ 481 STMT_START { \ 482 PERL_SI *next = PL_curstackinfo->si_next; \ 483 if (!next) { \ 484 next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \ 485 next->si_prev = PL_curstackinfo; \ 486 PL_curstackinfo->si_next = next; \ 487 } \ 488 next->si_type = type; \ 489 next->si_cxix = -1; \ 490 AvFILLp(next->si_stack) = 0; \ 491 SWITCHSTACK(PL_curstack,next->si_stack); \ 492 PL_curstackinfo = next; \ 493 SET_MARK_OFFSET; \ 494 } STMT_END 495 496 #define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN) 497 498 /* POPSTACK works with PL_stack_sp, so it may need to be bracketed by 499 * PUTBACK/SPAGAIN to flush/refresh any local SP that may be active */ 500 #define POPSTACK \ 501 STMT_START { \ 502 dSP; \ 503 PERL_SI *prev = PL_curstackinfo->si_prev; \ 504 if (!prev) { \ 505 PerlIO_printf(Perl_error_log, "panic: POPSTACK\n"); \ 506 my_exit(1); \ 507 } \ 508 SWITCHSTACK(PL_curstack,prev->si_stack); \ 509 /* don't free prev here, free them all at the END{} */ \ 510 PL_curstackinfo = prev; \ 511 } STMT_END 512 513 #define POPSTACK_TO(s) \ 514 STMT_START { \ 515 while (PL_curstack != s) { \ 516 dounwind(-1); \ 517 POPSTACK; \ 518 } \ 519 } STMT_END 520