1 /* scope.h 2 * 3 * Copyright (C) 1993, 1994, 1996, 1997, 1998, 1999, 4 * 2000, 2001, 2002, 2004, 2005 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 #define SAVEt_ITEM 0 12 #define SAVEt_SV 1 13 #define SAVEt_AV 2 14 #define SAVEt_HV 3 15 #define SAVEt_INT 4 16 #define SAVEt_LONG 5 17 #define SAVEt_I32 6 18 #define SAVEt_IV 7 19 #define SAVEt_SPTR 8 20 #define SAVEt_APTR 9 21 #define SAVEt_HPTR 10 22 #define SAVEt_PPTR 11 23 #define SAVEt_NSTAB 12 24 #define SAVEt_SVREF 13 25 #define SAVEt_GP 14 26 #define SAVEt_FREESV 15 27 #define SAVEt_FREEOP 16 28 #define SAVEt_FREEPV 17 29 #define SAVEt_CLEARSV 18 30 #define SAVEt_DELETE 19 31 #define SAVEt_DESTRUCTOR 20 32 #define SAVEt_REGCONTEXT 21 33 #define SAVEt_STACK_POS 22 34 #define SAVEt_I16 23 35 #define SAVEt_AELEM 24 36 #define SAVEt_HELEM 25 37 #define SAVEt_OP 26 38 #define SAVEt_HINTS 27 39 #define SAVEt_ALLOC 28 40 #define SAVEt_GENERIC_SVREF 29 41 #define SAVEt_DESTRUCTOR_X 30 42 #define SAVEt_VPTR 31 43 #define SAVEt_I8 32 44 #define SAVEt_COMPPAD 33 45 #define SAVEt_GENERIC_PVREF 34 46 #define SAVEt_PADSV 35 47 #define SAVEt_MORTALIZESV 36 48 #define SAVEt_SHARED_PVREF 37 49 #define SAVEt_BOOL 38 50 #define SAVEt_SAVESWITCHSTACK 40 51 52 #ifndef SCOPE_SAVES_SIGNAL_MASK 53 #define SCOPE_SAVES_SIGNAL_MASK 0 54 #endif 55 56 #define SSCHECK(need) if (PL_savestack_ix + (need) > PL_savestack_max) savestack_grow() 57 #define SSGROW(need) if (PL_savestack_ix + (need) > PL_savestack_max) savestack_grow_cnt(need) 58 #define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i)) 59 #define SSPUSHLONG(i) (PL_savestack[PL_savestack_ix++].any_long = (long)(i)) 60 #define SSPUSHBOOL(p) (PL_savestack[PL_savestack_ix++].any_bool = (p)) 61 #define SSPUSHIV(i) (PL_savestack[PL_savestack_ix++].any_iv = (IV)(i)) 62 #define SSPUSHPTR(p) (PL_savestack[PL_savestack_ix++].any_ptr = (void*)(p)) 63 #define SSPUSHDPTR(p) (PL_savestack[PL_savestack_ix++].any_dptr = (p)) 64 #define SSPUSHDXPTR(p) (PL_savestack[PL_savestack_ix++].any_dxptr = (p)) 65 #define SSPOPINT (PL_savestack[--PL_savestack_ix].any_i32) 66 #define SSPOPLONG (PL_savestack[--PL_savestack_ix].any_long) 67 #define SSPOPBOOL (PL_savestack[--PL_savestack_ix].any_bool) 68 #define SSPOPIV (PL_savestack[--PL_savestack_ix].any_iv) 69 #define SSPOPPTR (PL_savestack[--PL_savestack_ix].any_ptr) 70 #define SSPOPDPTR (PL_savestack[--PL_savestack_ix].any_dptr) 71 #define SSPOPDXPTR (PL_savestack[--PL_savestack_ix].any_dxptr) 72 73 /* 74 =head1 Callback Functions 75 76 =for apidoc Ams||SAVETMPS 77 Opening bracket for temporaries on a callback. See C<FREETMPS> and 78 L<perlcall>. 79 80 =for apidoc Ams||FREETMPS 81 Closing bracket for temporaries on a callback. See C<SAVETMPS> and 82 L<perlcall>. 83 84 =for apidoc Ams||ENTER 85 Opening bracket on a callback. See C<LEAVE> and L<perlcall>. 86 87 =for apidoc Ams||LEAVE 88 Closing bracket on a callback. See C<ENTER> and L<perlcall>. 89 90 =cut 91 */ 92 93 #define SAVETMPS save_int((int*)&PL_tmps_floor), PL_tmps_floor = PL_tmps_ix 94 #define FREETMPS if (PL_tmps_ix > PL_tmps_floor) free_tmps() 95 96 #ifdef DEBUGGING 97 #define ENTER \ 98 STMT_START { \ 99 push_scope(); \ 100 DEBUG_SCOPE("ENTER") \ 101 } STMT_END 102 #define LEAVE \ 103 STMT_START { \ 104 DEBUG_SCOPE("LEAVE") \ 105 pop_scope(); \ 106 } STMT_END 107 #else 108 #define ENTER push_scope() 109 #define LEAVE pop_scope() 110 #endif 111 #define LEAVE_SCOPE(old) if (PL_savestack_ix > old) leave_scope(old) 112 113 /* 114 * Not using SOFT_CAST on SAVESPTR, SAVEGENERICSV and SAVEFREESV 115 * because these are used for several kinds of pointer values 116 */ 117 #define SAVEI8(i) save_I8(SOFT_CAST(I8*)&(i)) 118 #define SAVEI16(i) save_I16(SOFT_CAST(I16*)&(i)) 119 #define SAVEI32(i) save_I32(SOFT_CAST(I32*)&(i)) 120 #define SAVEINT(i) save_int(SOFT_CAST(int*)&(i)) 121 #define SAVEIV(i) save_iv(SOFT_CAST(IV*)&(i)) 122 #define SAVELONG(l) save_long(SOFT_CAST(long*)&(l)) 123 #define SAVEBOOL(b) save_bool(SOFT_CAST(bool*)&(b)) 124 #define SAVESPTR(s) save_sptr((SV**)&(s)) 125 #define SAVEPPTR(s) save_pptr(SOFT_CAST(char**)&(s)) 126 #define SAVEVPTR(s) save_vptr((void*)&(s)) 127 #define SAVEPADSV(s) save_padsv(s) 128 #define SAVEFREESV(s) save_freesv((SV*)(s)) 129 #define SAVEMORTALIZESV(s) save_mortalizesv((SV*)(s)) 130 #define SAVEFREEOP(o) save_freeop(SOFT_CAST(OP*)(o)) 131 #define SAVEFREEPV(p) save_freepv(SOFT_CAST(char*)(p)) 132 #define SAVECLEARSV(sv) save_clearsv(SOFT_CAST(SV**)&(sv)) 133 #define SAVEGENERICSV(s) save_generic_svref((SV**)&(s)) 134 #define SAVEGENERICPV(s) save_generic_pvref((char**)&(s)) 135 #define SAVESHAREDPV(s) save_shared_pvref((char**)&(s)) 136 #define SAVEDELETE(h,k,l) \ 137 save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l)) 138 #define SAVEDESTRUCTOR(f,p) \ 139 save_destructor((DESTRUCTORFUNC_NOCONTEXT_t)(f), SOFT_CAST(void*)(p)) 140 141 #define SAVEDESTRUCTOR_X(f,p) \ 142 save_destructor_x((DESTRUCTORFUNC_t)(f), SOFT_CAST(void*)(p)) 143 144 #define SAVESTACK_POS() \ 145 STMT_START { \ 146 SSCHECK(2); \ 147 SSPUSHINT(PL_stack_sp - PL_stack_base); \ 148 SSPUSHINT(SAVEt_STACK_POS); \ 149 } STMT_END 150 151 #define SAVEOP() save_op() 152 153 #define SAVEHINTS() \ 154 STMT_START { \ 155 SSCHECK(3); \ 156 if (PL_hints & HINT_LOCALIZE_HH) { \ 157 SSPUSHPTR(GvHV(PL_hintgv)); \ 158 GvHV(PL_hintgv) = newHVhv(GvHV(PL_hintgv)); \ 159 } \ 160 SSPUSHINT(PL_hints); \ 161 SSPUSHINT(SAVEt_HINTS); \ 162 } STMT_END 163 164 #define SAVECOMPPAD() \ 165 STMT_START { \ 166 SSCHECK(2); \ 167 SSPUSHPTR((SV*)PL_comppad); \ 168 SSPUSHINT(SAVEt_COMPPAD); \ 169 } STMT_END 170 171 #define SAVESWITCHSTACK(f,t) \ 172 STMT_START { \ 173 SSCHECK(3); \ 174 SSPUSHPTR((SV*)(f)); \ 175 SSPUSHPTR((SV*)(t)); \ 176 SSPUSHINT(SAVEt_SAVESWITCHSTACK); \ 177 SWITCHSTACK((f),(t)); \ 178 PL_curstackinfo->si_stack = (t); \ 179 } STMT_END 180 181 #ifdef USE_ITHREADS 182 # define SAVECOPSTASH(c) SAVEPPTR(CopSTASHPV(c)) 183 # define SAVECOPSTASH_FREE(c) SAVESHAREDPV(CopSTASHPV(c)) 184 # define SAVECOPFILE(c) SAVEPPTR(CopFILE(c)) 185 # define SAVECOPFILE_FREE(c) SAVESHAREDPV(CopFILE(c)) 186 #else 187 # define SAVECOPSTASH(c) SAVESPTR(CopSTASH(c)) 188 # define SAVECOPSTASH_FREE(c) SAVECOPSTASH(c) /* XXX not refcounted */ 189 # define SAVECOPFILE(c) SAVESPTR(CopFILEGV(c)) 190 # define SAVECOPFILE_FREE(c) SAVEGENERICSV(CopFILEGV(c)) 191 #endif 192 193 #define SAVECOPLINE(c) SAVEI32(CopLINE(c)) 194 195 /* SSNEW() temporarily allocates a specified number of bytes of data on the 196 * savestack. It returns an integer index into the savestack, because a 197 * pointer would get broken if the savestack is moved on reallocation. 198 * SSNEWa() works like SSNEW(), but also aligns the data to the specified 199 * number of bytes. MEM_ALIGNBYTES is perhaps the most useful. The 200 * alignment will be preserved therough savestack reallocation *only* if 201 * realloc returns data aligned to a size divisible by "align"! 202 * 203 * SSPTR() converts the index returned by SSNEW/SSNEWa() into a pointer. 204 */ 205 206 #define SSNEW(size) Perl_save_alloc(aTHX_ (size), 0) 207 #define SSNEWt(n,t) SSNEW((n)*sizeof(t)) 208 #define SSNEWa(size,align) Perl_save_alloc(aTHX_ (size), \ 209 (align - ((int)((caddr_t)&PL_savestack[PL_savestack_ix]) % align)) % align) 210 #define SSNEWat(n,t,align) SSNEWa((n)*sizeof(t), align) 211 212 #define SSPTR(off,type) ((type) ((char*)PL_savestack + off)) 213 #define SSPTRt(off,type) ((type*) ((char*)PL_savestack + off)) 214 215 /* A jmpenv packages the state required to perform a proper non-local jump. 216 * Note that there is a start_env initialized when perl starts, and top_env 217 * points to this initially, so top_env should always be non-null. 218 * 219 * Existence of a non-null top_env->je_prev implies it is valid to call 220 * longjmp() at that runlevel (we make sure start_env.je_prev is always 221 * null to ensure this). 222 * 223 * je_mustcatch, when set at any runlevel to TRUE, means eval ops must 224 * establish a local jmpenv to handle exception traps. Care must be taken 225 * to restore the previous value of je_mustcatch before exiting the 226 * stack frame iff JMPENV_PUSH was not called in that stack frame. 227 * GSAR 97-03-27 228 */ 229 230 struct jmpenv { 231 struct jmpenv * je_prev; 232 Sigjmp_buf je_buf; /* only for use if !je_throw */ 233 int je_ret; /* last exception thrown */ 234 bool je_mustcatch; /* need to call longjmp()? */ 235 #ifdef PERL_FLEXIBLE_EXCEPTIONS 236 void (*je_throw)(int v); /* last for bincompat */ 237 bool je_noset; /* no need for setjmp() */ 238 #endif 239 }; 240 241 typedef struct jmpenv JMPENV; 242 243 #ifdef OP_IN_REGISTER 244 #define OP_REG_TO_MEM PL_opsave = op 245 #define OP_MEM_TO_REG op = PL_opsave 246 #else 247 #define OP_REG_TO_MEM NOOP 248 #define OP_MEM_TO_REG NOOP 249 #endif 250 251 /* 252 * How to build the first jmpenv. 253 * 254 * top_env needs to be non-zero. It points to an area 255 * in which longjmp() stuff is stored, as C callstack 256 * info there at least is thread specific this has to 257 * be per-thread. Otherwise a 'die' in a thread gives 258 * that thread the C stack of last thread to do an eval {}! 259 */ 260 261 #define JMPENV_BOOTSTRAP \ 262 STMT_START { \ 263 Zero(&PL_start_env, 1, JMPENV); \ 264 PL_start_env.je_ret = -1; \ 265 PL_start_env.je_mustcatch = TRUE; \ 266 PL_top_env = &PL_start_env; \ 267 } STMT_END 268 269 #ifdef PERL_FLEXIBLE_EXCEPTIONS 270 271 /* 272 * These exception-handling macros are split up to 273 * ease integration with C++ exceptions. 274 * 275 * To use C++ try+catch to catch Perl exceptions, an extension author 276 * needs to first write an extern "C" function to throw an appropriate 277 * exception object; typically it will be or contain an integer, 278 * because Perl's internals use integers to track exception types: 279 * extern "C" { static void thrower(int i) { throw i; } } 280 * 281 * Then (as shown below) the author needs to use, not the simple 282 * JMPENV_PUSH, but several of its constitutent macros, to arrange for 283 * the Perl internals to call thrower() rather than longjmp() to 284 * report exceptions: 285 * 286 * dJMPENV; 287 * JMPENV_PUSH_INIT(thrower); 288 * try { 289 * ... stuff that may throw exceptions ... 290 * } 291 * catch (int why) { // or whatever matches thrower() 292 * JMPENV_POST_CATCH; 293 * EXCEPT_SET(why); 294 * switch (why) { 295 * ... // handle various Perl exception codes 296 * } 297 * } 298 * JMPENV_POP; // don't forget this! 299 */ 300 301 /* 302 * Function that catches/throws, and its callback for the 303 * body of protected processing. 304 */ 305 typedef void *(CPERLscope(*protect_body_t)) (pTHX_ va_list); 306 typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env, 307 int *, protect_body_t, ...); 308 309 #define dJMPENV JMPENV cur_env; \ 310 volatile JMPENV *pcur_env = ((cur_env.je_noset = 0),&cur_env) 311 312 #define JMPENV_PUSH_INIT_ENV(ce,THROWFUNC) \ 313 STMT_START { \ 314 (ce).je_throw = (THROWFUNC); \ 315 (ce).je_ret = -1; \ 316 (ce).je_mustcatch = FALSE; \ 317 (ce).je_prev = PL_top_env; \ 318 PL_top_env = &(ce); \ 319 OP_REG_TO_MEM; \ 320 } STMT_END 321 322 #define JMPENV_PUSH_INIT(THROWFUNC) JMPENV_PUSH_INIT_ENV(*(JMPENV*)pcur_env,THROWFUNC) 323 324 #define JMPENV_POST_CATCH_ENV(ce) \ 325 STMT_START { \ 326 OP_MEM_TO_REG; \ 327 PL_top_env = &(ce); \ 328 } STMT_END 329 330 #define JMPENV_POST_CATCH JMPENV_POST_CATCH_ENV(*(JMPENV*)pcur_env) 331 332 #define JMPENV_PUSH_ENV(ce,v) \ 333 STMT_START { \ 334 if (!(ce).je_noset) { \ 335 DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n", \ 336 ce, PL_top_env)); \ 337 JMPENV_PUSH_INIT_ENV(ce,NULL); \ 338 EXCEPT_SET_ENV(ce,PerlProc_setjmp((ce).je_buf, SCOPE_SAVES_SIGNAL_MASK));\ 339 (ce).je_noset = 1; \ 340 } \ 341 else \ 342 EXCEPT_SET_ENV(ce,0); \ 343 JMPENV_POST_CATCH_ENV(ce); \ 344 (v) = EXCEPT_GET_ENV(ce); \ 345 } STMT_END 346 347 #define JMPENV_PUSH(v) JMPENV_PUSH_ENV(*(JMPENV*)pcur_env,v) 348 349 #define JMPENV_POP_ENV(ce) \ 350 STMT_START { \ 351 if (PL_top_env == &(ce)) \ 352 PL_top_env = (ce).je_prev; \ 353 } STMT_END 354 355 #define JMPENV_POP JMPENV_POP_ENV(*(JMPENV*)pcur_env) 356 357 #define JMPENV_JUMP(v) \ 358 STMT_START { \ 359 OP_REG_TO_MEM; \ 360 if (PL_top_env->je_prev) { \ 361 if (PL_top_env->je_throw) \ 362 PL_top_env->je_throw(v); \ 363 else \ 364 PerlProc_longjmp(PL_top_env->je_buf, (v)); \ 365 } \ 366 if ((v) == 2) \ 367 PerlProc_exit(STATUS_NATIVE_EXPORT); \ 368 PerlIO_printf(Perl_error_log, "panic: top_env\n"); \ 369 PerlProc_exit(1); \ 370 } STMT_END 371 372 #define EXCEPT_GET_ENV(ce) ((ce).je_ret) 373 #define EXCEPT_GET EXCEPT_GET_ENV(*(JMPENV*)pcur_env) 374 #define EXCEPT_SET_ENV(ce,v) ((ce).je_ret = (v)) 375 #define EXCEPT_SET(v) EXCEPT_SET_ENV(*(JMPENV*)pcur_env,v) 376 377 #else /* !PERL_FLEXIBLE_EXCEPTIONS */ 378 379 #define dJMPENV JMPENV cur_env 380 381 #define JMPENV_PUSH(v) \ 382 STMT_START { \ 383 DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n", \ 384 &cur_env, PL_top_env)); \ 385 cur_env.je_prev = PL_top_env; \ 386 OP_REG_TO_MEM; \ 387 cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK); \ 388 OP_MEM_TO_REG; \ 389 PL_top_env = &cur_env; \ 390 cur_env.je_mustcatch = FALSE; \ 391 (v) = cur_env.je_ret; \ 392 } STMT_END 393 394 #define JMPENV_POP \ 395 STMT_START { PL_top_env = cur_env.je_prev; } STMT_END 396 397 #define JMPENV_JUMP(v) \ 398 STMT_START { \ 399 OP_REG_TO_MEM; \ 400 if (PL_top_env->je_prev) \ 401 PerlProc_longjmp(PL_top_env->je_buf, (v)); \ 402 if ((v) == 2) \ 403 PerlProc_exit(STATUS_NATIVE_EXPORT); \ 404 PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); \ 405 PerlProc_exit(1); \ 406 } STMT_END 407 408 #endif /* PERL_FLEXIBLE_EXCEPTIONS */ 409 410 #define CATCH_GET (PL_top_env->je_mustcatch) 411 #define CATCH_SET(v) (PL_top_env->je_mustcatch = (v)) 412