run.c

   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  */