1 /* run.c 2 * 3 * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 4 * 2000, 2001, 2004, 2005, 2006, 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 /* This file contains the main Perl opcode execution loop. It just 12 * calls the pp_foo() function associated with each op, and expects that 13 * function to return a pointer to the next op to be executed, or null if 14 * it's the end of the sub or program or whatever. 15 * 16 * There is a similar loop in dump.c, Perl_runops_debug(), which does 17 * the same, but also checks for various debug flags each time round the 18 * loop. 19 * 20 * Why this function requires a file all of its own is anybody's guess. 21 * DAPM. 22 */ 23 24 #include "EXTERN.h" 25 #define PERL_IN_RUN_C 26 #include "perl.h" 27 28 /* 29 * 'Away now, Shadowfax! Run, greatheart, run as you have never run before! 30 * Now we are come to the lands where you were foaled, and every stone you 31 * know. Run now! Hope is in speed!' --Gandalf 32 * 33 * [p.600 of _The Lord of the Rings_, III/xi: "The Palantír"] 34 */ 35 36 int 37 Perl_runops_standard(pTHX) 38 { 39 OP *op = PL_op; 40 PERL_DTRACE_PROBE_OP(op); 41 while ((PL_op = op = op->op_ppaddr(aTHX))) { 42 PERL_DTRACE_PROBE_OP(op); 43 } 44 PERL_ASYNC_CHECK(); 45 46 TAINT_NOT; 47 return 0; 48 } 49 50 51 #ifdef PERL_RC_STACK 52 53 /* this is a wrapper for all runops-style functions. It temporarily 54 * reifies the stack if necessary, then calls the real runops function 55 */ 56 int 57 Perl_runops_wrap(pTHX) 58 { 59 /* runops loops assume a ref-counted stack. If we have been called via a 60 * wrapper (pp_wrap or xs_wrap) with the top half of the stack not 61 * reference-counted, or with a non-real stack, temporarily convert it 62 * to reference-counted. This is because the si_stack_nonrc_base 63 * mechanism only allows a single split in the stack, not multiple 64 * stripes. 65 * At the end, we revert the stack (or part thereof) to non-refcounted 66 * to keep whoever our caller is happy. 67 * 68 * If what we call croaks, catch it, revert, then rethrow. 69 */ 70 71 I32 cut; /* the cut point between refcnted and non-refcnted */ 72 bool was_real = cBOOL(AvREAL(PL_curstack)); 73 I32 old_base = PL_curstackinfo->si_stack_nonrc_base; 74 75 if (was_real && !old_base) { 76 PL_runops(aTHX); /* call the real loop */ 77 return 0; 78 } 79 80 if (was_real) { 81 cut = old_base; 82 assert(PL_stack_base + cut <= PL_stack_sp + 1); 83 PL_curstackinfo->si_stack_nonrc_base = 0; 84 } 85 else { 86 assert(!old_base); 87 assert(!AvREIFY(PL_curstack)); 88 AvREAL_on(PL_curstack); 89 /* skip the PL_sv_undef guard at PL_stack_base[0] but still 90 * signal adjusting may be needed on return by setting to a 91 * non-zero value - even if stack is empty */ 92 cut = 1; 93 } 94 95 if (cut) { 96 SV **svp = PL_stack_base + cut; 97 while (svp <= PL_stack_sp) { 98 SvREFCNT_inc_simple_void(*svp); 99 svp++; 100 } 101 } 102 103 AV * old_curstack = PL_curstack; 104 105 /* run the real loop while catching exceptions */ 106 dJMPENV; 107 int ret; 108 JMPENV_PUSH(ret); 109 switch (ret) { 110 case 0: /* normal return from JMPENV_PUSH */ 111 cur_env.je_mustcatch = cur_env.je_prev->je_mustcatch; 112 PL_runops(aTHX); /* call the real loop */ 113 114 revert: 115 /* revert stack back its non-ref-counted state */ 116 assert(AvREAL(PL_curstack)); 117 118 if (cut) { 119 /* undo the stack reification that took place at the beginning of 120 * this function */ 121 if (UNLIKELY(!was_real)) 122 AvREAL_off(PL_curstack); 123 124 SSize_t n = PL_stack_sp - (PL_stack_base + cut) + 1; 125 if (n > 0) { 126 /* we need to decrement the refcount of every SV from cut 127 * upwards; but this may prematurely free them, so 128 * mortalise them instead */ 129 EXTEND_MORTAL(n); 130 for (SSize_t i = 0; i < n; i ++) { 131 SV* sv = PL_stack_base[cut + i]; 132 if (sv) 133 PL_tmps_stack[++PL_tmps_ix] = sv; 134 } 135 } 136 137 I32 sp1 = PL_stack_sp - PL_stack_base + 1; 138 PL_curstackinfo->si_stack_nonrc_base = 139 old_base > sp1 ? sp1 : old_base; 140 } 141 break; 142 143 case 3: /* exception trapped by eval - stack only partially unwound */ 144 145 /* if the exception has already unwound to before the current 146 * stack, no need to fix it up */ 147 if (old_curstack == PL_curstack) 148 goto revert; 149 break; 150 151 default: 152 break; 153 } 154 155 JMPENV_POP; 156 157 if (ret) { 158 JMPENV_JUMP(ret); /* re-throw the exception */ 159 NOT_REACHED; /* NOTREACHED */ 160 } 161 162 return 0; 163 } 164 165 #endif 166 167 /* 168 * ex: set ts=8 sts=4 sw=4 et: 169 */ 170