home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / lib / perl / 5.10.0 / CORE / cop.h < prev    next >
Encoding:
C/C++ Source or Header  |  2009-06-26  |  29.2 KB  |  896 lines
  1. /*    cop.h
  2.  *
  3.  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
  4.  *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 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.  * Control ops (cops) are one of the three ops OP_NEXTSTATE, OP_DBSTATE,
  10.  * and OP_SETSTATE that (loosely speaking) are separate statements.
  11.  * They hold information important for lexical state and error reporting.
  12.  * At run time, PL_curcop is set to point to the most recently executed cop,
  13.  * and thus can be used to determine our current state.
  14.  */
  15.  
  16. /* A jmpenv packages the state required to perform a proper non-local jump.
  17.  * Note that there is a start_env initialized when perl starts, and top_env
  18.  * points to this initially, so top_env should always be non-null.
  19.  *
  20.  * Existence of a non-null top_env->je_prev implies it is valid to call
  21.  * longjmp() at that runlevel (we make sure start_env.je_prev is always
  22.  * null to ensure this).
  23.  *
  24.  * je_mustcatch, when set at any runlevel to TRUE, means eval ops must
  25.  * establish a local jmpenv to handle exception traps.  Care must be taken
  26.  * to restore the previous value of je_mustcatch before exiting the
  27.  * stack frame iff JMPENV_PUSH was not called in that stack frame.
  28.  * GSAR 97-03-27
  29.  */
  30.  
  31. struct jmpenv {
  32.     struct jmpenv *    je_prev;
  33.     Sigjmp_buf        je_buf;        /* only for use if !je_throw */
  34.     int            je_ret;        /* last exception thrown */
  35.     bool        je_mustcatch;    /* need to call longjmp()? */
  36. };
  37.  
  38. typedef struct jmpenv JMPENV;
  39.  
  40. #ifdef OP_IN_REGISTER
  41. #define OP_REG_TO_MEM    PL_opsave = op
  42. #define OP_MEM_TO_REG    op = PL_opsave
  43. #else
  44. #define OP_REG_TO_MEM    NOOP
  45. #define OP_MEM_TO_REG    NOOP
  46. #endif
  47.  
  48. /*
  49.  * How to build the first jmpenv.
  50.  *
  51.  * top_env needs to be non-zero. It points to an area
  52.  * in which longjmp() stuff is stored, as C callstack
  53.  * info there at least is thread specific this has to
  54.  * be per-thread. Otherwise a 'die' in a thread gives
  55.  * that thread the C stack of last thread to do an eval {}!
  56.  */
  57.  
  58. #define JMPENV_BOOTSTRAP \
  59.     STMT_START {                \
  60.     Zero(&PL_start_env, 1, JMPENV);        \
  61.     PL_start_env.je_ret = -1;        \
  62.     PL_start_env.je_mustcatch = TRUE;    \
  63.     PL_top_env = &PL_start_env;        \
  64.     } STMT_END
  65.  
  66. /*
  67.  *   PERL_FLEXIBLE_EXCEPTIONS
  68.  * 
  69.  * All the flexible exceptions code has been removed.
  70.  * See the following threads for details:
  71.  *
  72.  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-07/msg00378.html
  73.  * 
  74.  * Joshua's original patches (which weren't applied) and discussion:
  75.  * 
  76.  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01396.html
  77.  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01489.html
  78.  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01491.html
  79.  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01608.html
  80.  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02144.html
  81.  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02998.html
  82.  * 
  83.  * Chip's reworked patch and discussion:
  84.  * 
  85.  *   http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1999-03/msg00520.html
  86.  * 
  87.  * The flaw in these patches (which went unnoticed at the time) was
  88.  * that they moved some code that could potentially die() out of the
  89.  * region protected by the setjmp()s.  This caused exceptions within
  90.  * END blocks and such to not be handled by the correct setjmp().
  91.  * 
  92.  * The original patches that introduces flexible exceptions were:
  93.  *
  94.  *   http://public.activestate.com/cgi-bin/perlbrowse?patch=3386
  95.  *   http://public.activestate.com/cgi-bin/perlbrowse?patch=5162
  96.  */
  97.  
  98. #define dJMPENV        JMPENV cur_env
  99.  
  100. #define JMPENV_PUSH(v) \
  101.     STMT_START {                            \
  102.     DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n",    \
  103.              (void*)&cur_env, (void*)PL_top_env));            \
  104.     cur_env.je_prev = PL_top_env;                    \
  105.     OP_REG_TO_MEM;                            \
  106.     cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK);        \
  107.     OP_MEM_TO_REG;                            \
  108.     PL_top_env = &cur_env;                        \
  109.     cur_env.je_mustcatch = FALSE;                    \
  110.     (v) = cur_env.je_ret;                        \
  111.     } STMT_END
  112.  
  113. #define JMPENV_POP \
  114.     STMT_START {                            \
  115.     DEBUG_l(Perl_deb(aTHX_ "popping jumplevel was %p, now %p\n",    \
  116.              (void*)PL_top_env, (void*)cur_env.je_prev));            \
  117.     PL_top_env = cur_env.je_prev;                    \
  118.     } STMT_END
  119.  
  120. #define JMPENV_JUMP(v) \
  121.     STMT_START {                        \
  122.     OP_REG_TO_MEM;                        \
  123.     if (PL_top_env->je_prev)                \
  124.         PerlProc_longjmp(PL_top_env->je_buf, (v));        \
  125.     if ((v) == 2)                        \
  126.         PerlProc_exit(STATUS_EXIT);                        \
  127.     PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");    \
  128.     PerlProc_exit(1);                    \
  129.     } STMT_END
  130.  
  131. #define CATCH_GET        (PL_top_env->je_mustcatch)
  132. #define CATCH_SET(v)        (PL_top_env->je_mustcatch = (v))
  133.  
  134.  
  135.  
  136. struct cop {
  137.     BASEOP
  138.     /* On LP64 putting this here takes advantage of the fact that BASEOP isn't
  139.        an exact multiple of 8 bytes to save structure padding.  */
  140.     line_t      cop_line;       /* line # of this command */
  141.     char *    cop_label;    /* label for this construct */
  142. #ifdef USE_ITHREADS
  143.     char *    cop_stashpv;    /* package line was compiled in */
  144.     char *    cop_file;    /* file name the following line # is from */
  145. #else
  146.     HV *    cop_stash;    /* package line was compiled in */
  147.     GV *    cop_filegv;    /* file the following line # is from */
  148. #endif
  149.     U32        cop_hints;    /* hints bits from pragmata */
  150.     U32        cop_seq;    /* parse sequence number */
  151.     /* Beware. mg.c and warnings.pl assume the type of this is STRLEN *:  */
  152.     STRLEN *    cop_warnings;    /* lexical warnings bitmask */
  153.     /* compile time state of %^H.  See the comment in op.c for how this is
  154.        used to recreate a hash to return from caller.  */
  155.     struct refcounted_he * cop_hints_hash;
  156. };
  157.  
  158. #ifdef USE_ITHREADS
  159. #  define CopFILE(c)        ((c)->cop_file)
  160. #  define CopFILEGV(c)        (CopFILE(c) \
  161.                  ? gv_fetchfile(CopFILE(c)) : NULL)
  162.                  
  163. #  ifdef NETWARE
  164. #    define CopFILE_set(c,pv)    ((c)->cop_file = savepv(pv))
  165. #    define CopFILE_setn(c,pv,l)  ((c)->cop_file = savepv((pv),(l)))
  166. #  else
  167. #    define CopFILE_set(c,pv)    ((c)->cop_file = savesharedpv(pv))
  168. #    define CopFILE_setn(c,pv,l)  ((c)->cop_file = savesharedpvn((pv),(l)))
  169. #  endif
  170.  
  171. #  define CopFILESV(c)        (CopFILE(c) \
  172.                  ? GvSV(gv_fetchfile(CopFILE(c))) : NULL)
  173. #  define CopFILEAV(c)        (CopFILE(c) \
  174.                  ? GvAV(gv_fetchfile(CopFILE(c))) : NULL)
  175. #  ifdef DEBUGGING
  176. #    define CopFILEAVx(c)    (assert(CopFILE(c)), \
  177.                    GvAV(gv_fetchfile(CopFILE(c))))
  178. #  else
  179. #    define CopFILEAVx(c)    (GvAV(gv_fetchfile(CopFILE(c))))
  180. #  endif
  181. #  define CopSTASHPV(c)        ((c)->cop_stashpv)
  182.  
  183. #  ifdef NETWARE
  184. #    define CopSTASHPV_set(c,pv)    ((c)->cop_stashpv = ((pv) ? savepv(pv) : NULL))
  185. #  else
  186. #    define CopSTASHPV_set(c,pv)    ((c)->cop_stashpv = savesharedpv(pv))
  187. #  endif
  188.  
  189. #  define CopSTASH(c)        (CopSTASHPV(c) \
  190.                  ? gv_stashpv(CopSTASHPV(c),GV_ADD) : NULL)
  191. #  define CopSTASH_set(c,hv)    CopSTASHPV_set(c, (hv) ? HvNAME_get(hv) : NULL)
  192. #  define CopSTASH_eq(c,hv)    ((hv) && stashpv_hvname_match(c,hv))
  193. #  define CopLABEL(c)        ((c)->cop_label)
  194. #  define CopLABEL_set(c,pv)    (CopLABEL(c) = (pv))
  195. #  ifdef NETWARE
  196. #    define CopSTASH_free(c) SAVECOPSTASH_FREE(c)
  197. #    define CopFILE_free(c) SAVECOPFILE_FREE(c)
  198. #    define CopLABEL_free(c) SAVECOPLABEL_FREE(c)
  199. #    define CopLABEL_alloc(pv)    ((pv)?savepv(pv):NULL)
  200. #  else
  201. #    define CopSTASH_free(c)    PerlMemShared_free(CopSTASHPV(c))
  202. #    define CopFILE_free(c)    (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = NULL))
  203. #    define CopLABEL_free(c)    (PerlMemShared_free(CopLABEL(c)),(CopLABEL(c) = NULL))
  204. #    define CopLABEL_alloc(pv)    ((pv)?savesharedpv(pv):NULL)
  205. #  endif
  206. #else
  207. #  define CopFILEGV(c)        ((c)->cop_filegv)
  208. #  define CopFILEGV_set(c,gv)    ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
  209. #  define CopFILE_set(c,pv)    CopFILEGV_set((c), gv_fetchfile(pv))
  210. #  define CopFILE_setn(c,pv,l)    CopFILEGV_set((c), gv_fetchfile_flags((pv),(l),0))
  211. #  define CopFILESV(c)        (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : NULL)
  212. #  define CopFILEAV(c)        (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : NULL)
  213. #  ifdef DEBUGGING
  214. #    define CopFILEAVx(c)    (assert(CopFILEGV(c)), GvAV(CopFILEGV(c)))
  215. #  else
  216. #    define CopFILEAVx(c)    (GvAV(CopFILEGV(c)))
  217. # endif
  218. #  define CopFILE(c)        (CopFILEGV(c) && GvSV(CopFILEGV(c)) \
  219.                     ? SvPVX(GvSV(CopFILEGV(c))) : NULL)
  220. #  define CopSTASH(c)        ((c)->cop_stash)
  221. #  define CopLABEL(c)        ((c)->cop_label)
  222. #  define CopSTASH_set(c,hv)    ((c)->cop_stash = (hv))
  223. #  define CopSTASHPV(c)        (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : NULL)
  224.    /* cop_stash is not refcounted */
  225. #  define CopSTASHPV_set(c,pv)    CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
  226. #  define CopSTASH_eq(c,hv)    (CopSTASH(c) == (hv))
  227. #  define CopLABEL_alloc(pv)    ((pv)?savepv(pv):NULL)
  228. #  define CopLABEL_set(c,pv)    (CopLABEL(c) = (pv))
  229. #  define CopSTASH_free(c)    
  230. #  define CopFILE_free(c)    (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL))
  231. #  define CopLABEL_free(c)    (Safefree(CopLABEL(c)),(CopLABEL(c) = NULL))
  232.  
  233. #endif /* USE_ITHREADS */
  234.  
  235. #define CopSTASH_ne(c,hv)    (!CopSTASH_eq(c,hv))
  236. #define CopLINE(c)        ((c)->cop_line)
  237. #define CopLINE_inc(c)        (++CopLINE(c))
  238. #define CopLINE_dec(c)        (--CopLINE(c))
  239. #define CopLINE_set(c,l)    (CopLINE(c) = (l))
  240.  
  241. /* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */
  242. #ifdef MACOS_TRADITIONAL
  243. #  define OutCopFILE(c) MacPerl_MPWFileName(CopFILE(c))
  244. #else
  245. #  define OutCopFILE(c) CopFILE(c)
  246. #endif
  247.  
  248. /* If $[ is non-zero, it's stored in cop_hints under the key "$[", and
  249.    HINT_ARYBASE is set to indicate this.
  250.    Setting it is ineficient due to the need to create 2 mortal SVs, but as
  251.    using $[ is highly discouraged, no sane Perl code will be using it.  */
  252. #define CopARYBASE_get(c)    \
  253.     ((CopHINTS_get(c) & HINT_ARYBASE)                \
  254.      ? SvIV(Perl_refcounted_he_fetch(aTHX_ (c)->cop_hints_hash, 0,    \
  255.                      "$[", 2, 0, 0))        \
  256.      : 0)
  257. #define CopARYBASE_set(c, b) STMT_START { \
  258.     if (b || ((c)->cop_hints & HINT_ARYBASE)) {            \
  259.         (c)->cop_hints |= HINT_ARYBASE;                \
  260.         if ((c) == &PL_compiling)                    \
  261.         PL_hints |= HINT_LOCALIZE_HH | HINT_ARYBASE;        \
  262.         (c)->cop_hints_hash                        \
  263.            = Perl_refcounted_he_new(aTHX_ (c)->cop_hints_hash,    \
  264.                     sv_2mortal(newSVpvs("$[")),    \
  265.                     sv_2mortal(newSViv(b)));    \
  266.     }                                \
  267.     } STMT_END
  268.  
  269. /* FIXME NATIVE_HINTS if this is changed from op_private (see perl.h)  */
  270. #define CopHINTS_get(c)        ((c)->cop_hints + 0)
  271. #define CopHINTS_set(c, h)    STMT_START {                \
  272.                     (c)->cop_hints = (h);        \
  273.                 } STMT_END
  274.  
  275. /*
  276.  * Here we have some enormously heavy (or at least ponderous) wizardry.
  277.  */
  278.  
  279. /* subroutine context */
  280. struct block_sub {
  281.     CV *    cv;
  282.     GV *    gv;
  283.     GV *    dfoutgv;
  284.     AV *    savearray;
  285.     AV *    argarray;
  286.     I32        olddepth;
  287.     U8        hasargs;
  288.     U8        lval;        /* XXX merge lval and hasargs? */
  289.     PAD        *oldcomppad;
  290.     OP *    retop;    /* op to execute on exit from sub */
  291. };
  292.  
  293. /* base for the next two macros. Don't use directly.
  294.  * Note that the refcnt of the cv is incremented twice;  The CX one is
  295.  * decremented by LEAVESUB, the other by LEAVE. */
  296.  
  297. #define PUSHSUB_BASE(cx)                        \
  298.     cx->blk_sub.cv = cv;                        \
  299.     cx->blk_sub.olddepth = CvDEPTH(cv);                \
  300.     cx->blk_sub.hasargs = hasargs;                    \
  301.     cx->blk_sub.retop = NULL;                    \
  302.     if (!CvDEPTH(cv)) {                        \
  303.         SvREFCNT_inc_simple_void_NN(cv);                \
  304.         SvREFCNT_inc_simple_void_NN(cv);                \
  305.         SAVEFREESV(cv);                        \
  306.     }
  307.  
  308.  
  309. #define PUSHSUB(cx)                            \
  310.     PUSHSUB_BASE(cx)                        \
  311.     cx->blk_sub.lval = PL_op->op_private &                          \
  312.                           (OPpLVAL_INTRO|OPpENTERSUB_INARGS);
  313.  
  314. /* variant for use by OP_DBSTATE, where op_private holds hint bits */
  315. #define PUSHSUB_DB(cx)                            \
  316.     PUSHSUB_BASE(cx)                        \
  317.     cx->blk_sub.lval = 0;
  318.  
  319.  
  320. #define PUSHFORMAT(cx)                            \
  321.     cx->blk_sub.cv = cv;                        \
  322.     cx->blk_sub.gv = gv;                        \
  323.     cx->blk_sub.retop = NULL;                    \
  324.     cx->blk_sub.hasargs = 0;                    \
  325.     cx->blk_sub.dfoutgv = PL_defoutgv;                \
  326.     SvREFCNT_inc_void(cx->blk_sub.dfoutgv)
  327.  
  328. #define POP_SAVEARRAY()                        \
  329.     STMT_START {                            \
  330.     SvREFCNT_dec(GvAV(PL_defgv));                    \
  331.     GvAV(PL_defgv) = cx->blk_sub.savearray;                \
  332.     } STMT_END
  333.  
  334. /* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't
  335.  * leave any (a fast av_clear(ary), basically) */
  336. #define CLEAR_ARGARRAY(ary) \
  337.     STMT_START {                            \
  338.     AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary);            \
  339.     AvARRAY(ary) = AvALLOC(ary);                    \
  340.     AvFILLp(ary) = -1;                        \
  341.     } STMT_END
  342.  
  343. #define POPSUB(cx,sv)                            \
  344.     STMT_START {                            \
  345.     if (cx->blk_sub.hasargs) {                    \
  346.         POP_SAVEARRAY();                        \
  347.         /* abandon @_ if it got reified */                \
  348.         if (AvREAL(cx->blk_sub.argarray)) {                \
  349.         const SSize_t fill = AvFILLp(cx->blk_sub.argarray);    \
  350.         SvREFCNT_dec(cx->blk_sub.argarray);            \
  351.         cx->blk_sub.argarray = newAV();                \
  352.         av_extend(cx->blk_sub.argarray, fill);            \
  353.         AvREIFY_only(cx->blk_sub.argarray);            \
  354.         CX_CURPAD_SV(cx->blk_sub, 0) = (SV*)cx->blk_sub.argarray;    \
  355.         }                                \
  356.         else {                            \
  357.         CLEAR_ARGARRAY(cx->blk_sub.argarray);            \
  358.         }                                \
  359.     }                                \
  360.     sv = (SV*)cx->blk_sub.cv;                    \
  361.     if (sv && (CvDEPTH((CV*)sv) = cx->blk_sub.olddepth))        \
  362.         sv = NULL;                        \
  363.     } STMT_END
  364.  
  365. #define LEAVESUB(sv)                            \
  366.     STMT_START {                            \
  367.     if (sv)                                \
  368.         SvREFCNT_dec(sv);                        \
  369.     } STMT_END
  370.  
  371. #define POPFORMAT(cx)                            \
  372.     setdefout(cx->blk_sub.dfoutgv);                    \
  373.     SvREFCNT_dec(cx->blk_sub.dfoutgv);
  374.  
  375. /* eval context */
  376. struct block_eval {
  377.     U8        old_in_eval;
  378.     U16        old_op_type;
  379.     SV *    old_namesv;
  380.     OP *    old_eval_root;
  381.     SV *    cur_text;
  382.     CV *    cv;
  383.     OP *    retop;    /* op to execute on exit from eval */
  384.     JMPENV *    cur_top_env; /* value of PL_top_env when eval CX created */
  385. };
  386.  
  387. #define PUSHEVAL(cx,n,fgv)                        \
  388.     STMT_START {                            \
  389.     cx->blk_eval.old_in_eval = PL_in_eval;                \
  390.     cx->blk_eval.old_op_type = PL_op->op_type;            \
  391.     cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : NULL);        \
  392.     cx->blk_eval.old_eval_root = PL_eval_root;            \
  393.     cx->blk_eval.cur_text = PL_parser ? PL_parser->linestr : NULL;    \
  394.     cx->blk_eval.cv = NULL; /* set by doeval(), as applicable */    \
  395.     cx->blk_eval.retop = NULL;                    \
  396.     cx->blk_eval.cur_top_env = PL_top_env;                 \
  397.     } STMT_END
  398.  
  399. #define POPEVAL(cx)                            \
  400.     STMT_START {                            \
  401.     PL_in_eval = cx->blk_eval.old_in_eval;                \
  402.     optype = cx->blk_eval.old_op_type;                \
  403.     PL_eval_root = cx->blk_eval.old_eval_root;            \
  404.     if (cx->blk_eval.old_namesv)                    \
  405.         sv_2mortal(cx->blk_eval.old_namesv);            \
  406.     } STMT_END
  407.  
  408. /* loop context */
  409. struct block_loop {
  410.     char *    label;
  411.     I32        resetsp;
  412.     LOOP *    my_op;    /* My op, that contains redo, next and last ops.  */
  413.     /* (except for non_ithreads we need to modify next_op in pp_ctl.c, hence
  414.     why next_op is conditionally defined below.)  */
  415. #ifdef USE_ITHREADS
  416.     void *    iterdata;
  417.     PAD        *oldcomppad;
  418. #else
  419.     OP *    next_op;
  420.     SV **    itervar;
  421. #endif
  422.     SV *    itersave;
  423.     /* (from inspection of source code) for a .. range of strings this is the
  424.        current string.  */
  425.     SV *    iterlval;
  426.     /* (from inspection of source code) for a foreach loop this is the array
  427.        being iterated over. For a .. range of numbers it's the current value.
  428.        A check is often made on the SvTYPE of iterary to determine whether
  429.        we are iterating over an array or a range. (numbers or strings)  */
  430.     AV *    iterary;
  431.     IV        iterix;
  432.     /* (from inspection of source code) for a .. range of numbers this is the
  433.        maximum value.  */
  434.     IV        itermax;
  435. };
  436. /* It might be possible to squeeze this structure further. As best I can tell
  437.    itermax and iterlval are never used at the same time, so it might be possible
  438.    to make them into a union. However, I'm not confident that there are enough
  439.    flag bits/NULLable pointers in this structure alone to encode which is
  440.    active. There is, however, U8 of space free in struct block, which could be
  441.    used. Right now it may not be worth squeezing this structure further, as it's
  442.    the largest part of struct block, and currently struct block is 64 bytes on
  443.    an ILP32 system, which will give good cache alignment.
  444. */
  445.  
  446. #ifdef USE_ITHREADS
  447. #  define CxITERVAR(c)                            \
  448.     ((c)->blk_loop.iterdata                        \
  449.      ? (CxPADLOOP(cx)                         \
  450.         ? &CX_CURPAD_SV( (c)->blk_loop,                 \
  451.             INT2PTR(PADOFFSET, (c)->blk_loop.iterdata))        \
  452.         : &GvSV((GV*)(c)->blk_loop.iterdata))            \
  453.      : (SV**)NULL)
  454. #  define CX_ITERDATA_SET(cx,idata)                    \
  455.     CX_CURPAD_SAVE(cx->blk_loop);                    \
  456.     if ((cx->blk_loop.iterdata = (idata)))                \
  457.         cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx));    \
  458.     else                                \
  459.         cx->blk_loop.itersave = NULL;
  460. #else
  461. #  define CxITERVAR(c)        ((c)->blk_loop.itervar)
  462. #  define CX_ITERDATA_SET(cx,ivar)                    \
  463.     if ((cx->blk_loop.itervar = (SV**)(ivar)))            \
  464.         cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx));    \
  465.     else                                \
  466.         cx->blk_loop.itersave = NULL;
  467. #endif
  468.  
  469. #ifdef USE_ITHREADS
  470. #  define PUSHLOOP_OP_NEXT        /* No need to do anything.  */
  471. #  define CX_LOOP_NEXTOP_GET(cx)    ((cx)->blk_loop.my_op->op_nextop + 0)
  472. #else
  473. #  define PUSHLOOP_OP_NEXT        cx->blk_loop.next_op = cLOOP->op_nextop
  474. #  define CX_LOOP_NEXTOP_GET(cx)    ((cx)->blk_loop.next_op + 0)
  475. #endif
  476.  
  477. #define PUSHLOOP(cx, dat, s)                        \
  478.     cx->blk_loop.label = PL_curcop->cop_label;            \
  479.     cx->blk_loop.resetsp = s - PL_stack_base;            \
  480.     cx->blk_loop.my_op = cLOOP;                    \
  481.     PUSHLOOP_OP_NEXT;                        \
  482.     cx->blk_loop.iterlval = NULL;                    \
  483.     cx->blk_loop.iterary = NULL;                    \
  484.     cx->blk_loop.iterix = -1;                    \
  485.     CX_ITERDATA_SET(cx,dat);
  486.  
  487. #define POPLOOP(cx)                            \
  488.     SvREFCNT_dec(cx->blk_loop.iterlval);                \
  489.     if (CxITERVAR(cx)) {                        \
  490.             if (SvPADMY(cx->blk_loop.itersave)) {            \
  491.         SV ** const s_v_p = CxITERVAR(cx);            \
  492.         sv_2mortal(*s_v_p);                    \
  493.         *s_v_p = cx->blk_loop.itersave;                \
  494.         }                                \
  495.         else {                            \
  496.         SvREFCNT_dec(cx->blk_loop.itersave);            \
  497.         }                                \
  498.     }                                \
  499.     if (cx->blk_loop.iterary && cx->blk_loop.iterary != PL_curstack)\
  500.         SvREFCNT_dec(cx->blk_loop.iterary);
  501.  
  502. /* given/when context */
  503. struct block_givwhen {
  504.     OP *leave_op;
  505. };
  506.  
  507. #define PUSHGIVEN(cx)                            \
  508.     cx->blk_givwhen.leave_op = cLOGOP->op_other;
  509.  
  510. #define PUSHWHEN PUSHGIVEN
  511.  
  512. /* context common to subroutines, evals and loops */
  513. struct block {
  514.     U16        blku_type;    /* what kind of context this is */
  515.     U8        blku_gimme;    /* is this block running in list context? */
  516.     U8        blku_spare;    /* Padding to match with struct subst */
  517.     I32        blku_oldsp;    /* stack pointer to copy stuff down to */
  518.     COP *    blku_oldcop;    /* old curcop pointer */
  519.     I32        blku_oldmarksp;    /* mark stack index */
  520.     I32        blku_oldscopesp;    /* scope stack index */
  521.     PMOP *    blku_oldpm;    /* values of pattern match vars */
  522.  
  523.     union {
  524.     struct block_sub    blku_sub;
  525.     struct block_eval    blku_eval;
  526.     struct block_loop    blku_loop;
  527.     struct block_givwhen    blku_givwhen;
  528.     } blk_u;
  529. };
  530. #define blk_oldsp    cx_u.cx_blk.blku_oldsp
  531. #define blk_oldcop    cx_u.cx_blk.blku_oldcop
  532. #define blk_oldmarksp    cx_u.cx_blk.blku_oldmarksp
  533. #define blk_oldscopesp    cx_u.cx_blk.blku_oldscopesp
  534. #define blk_oldpm    cx_u.cx_blk.blku_oldpm
  535. #define blk_gimme    cx_u.cx_blk.blku_gimme
  536. #define blk_sub        cx_u.cx_blk.blk_u.blku_sub
  537. #define blk_eval    cx_u.cx_blk.blk_u.blku_eval
  538. #define blk_loop    cx_u.cx_blk.blk_u.blku_loop
  539. #define blk_givwhen    cx_u.cx_blk.blk_u.blku_givwhen
  540.  
  541. /* Enter a block. */
  542. #define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix],        \
  543.     cx->cx_type        = t,                    \
  544.     cx->blk_oldsp        = sp - PL_stack_base,            \
  545.     cx->blk_oldcop        = PL_curcop,                \
  546.     cx->blk_oldmarksp    = PL_markstack_ptr - PL_markstack,    \
  547.     cx->blk_oldscopesp    = PL_scopestack_ix,            \
  548.     cx->blk_oldpm        = PL_curpm,                \
  549.     cx->blk_gimme        = (U8)gimme;                \
  550.     DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n",    \
  551.             (long)cxstack_ix, PL_block_type[CxTYPE(cx)]); )
  552.  
  553. /* Exit a block (RETURN and LAST). */
  554. #define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--],            \
  555.     newsp         = PL_stack_base + cx->blk_oldsp,        \
  556.     PL_curcop     = cx->blk_oldcop,                \
  557.     PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp,        \
  558.     PL_scopestack_ix = cx->blk_oldscopesp,                \
  559.     pm         = cx->blk_oldpm,                \
  560.     gimme         = cx->blk_gimme;                \
  561.     DEBUG_SCOPE("POPBLOCK");                    \
  562.     DEBUG_l( PerlIO_printf(Perl_debug_log, "Leaving block %ld, type %s\n",        \
  563.             (long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); )
  564.  
  565. /* Continue a block elsewhere (NEXT and REDO). */
  566. #define TOPBLOCK(cx) cx  = &cxstack[cxstack_ix],            \
  567.     PL_stack_sp     = PL_stack_base + cx->blk_oldsp,        \
  568.     PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp,        \
  569.     PL_scopestack_ix = cx->blk_oldscopesp,                \
  570.     PL_curpm         = cx->blk_oldpm;                \
  571.     DEBUG_SCOPE("TOPBLOCK");
  572.  
  573. /* substitution context */
  574. struct subst {
  575.     U16        sbu_type;    /* what kind of context this is */
  576.     U8        sbu_once;    /* Actually both booleans, but U8 to matches */
  577.     U8        sbu_rxtainted;    /* struct block */
  578.     I32        sbu_iters;
  579.     I32        sbu_maxiters;
  580.     I32        sbu_rflags;
  581.     I32        sbu_oldsave;
  582.     char *    sbu_orig;
  583.     SV *    sbu_dstr;
  584.     SV *    sbu_targ;
  585.     char *    sbu_s;
  586.     char *    sbu_m;
  587.     char *    sbu_strend;
  588.     void *    sbu_rxres;
  589.     REGEXP *    sbu_rx;
  590. };
  591. #define sb_iters    cx_u.cx_subst.sbu_iters
  592. #define sb_maxiters    cx_u.cx_subst.sbu_maxiters
  593. #define sb_rflags    cx_u.cx_subst.sbu_rflags
  594. #define sb_oldsave    cx_u.cx_subst.sbu_oldsave
  595. #define sb_once        cx_u.cx_subst.sbu_once
  596. #define sb_rxtainted    cx_u.cx_subst.sbu_rxtainted
  597. #define sb_orig        cx_u.cx_subst.sbu_orig
  598. #define sb_dstr        cx_u.cx_subst.sbu_dstr
  599. #define sb_targ        cx_u.cx_subst.sbu_targ
  600. #define sb_s        cx_u.cx_subst.sbu_s
  601. #define sb_m        cx_u.cx_subst.sbu_m
  602. #define sb_strend    cx_u.cx_subst.sbu_strend
  603. #define sb_rxres    cx_u.cx_subst.sbu_rxres
  604. #define sb_rx        cx_u.cx_subst.sbu_rx
  605.  
  606. #define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix],            \
  607.     cx->sb_iters        = iters,                \
  608.     cx->sb_maxiters        = maxiters,                \
  609.     cx->sb_rflags        = r_flags,                \
  610.     cx->sb_oldsave        = oldsave,                \
  611.     cx->sb_once        = once,                    \
  612.     cx->sb_rxtainted    = rxtainted,                \
  613.     cx->sb_orig        = orig,                    \
  614.     cx->sb_dstr        = dstr,                    \
  615.     cx->sb_targ        = targ,                    \
  616.     cx->sb_s        = s,                    \
  617.     cx->sb_m        = m,                    \
  618.     cx->sb_strend        = strend,                \
  619.     cx->sb_rxres        = NULL,                    \
  620.     cx->sb_rx        = rx,                    \
  621.     cx->cx_type        = CXt_SUBST;                \
  622.     rxres_save(&cx->sb_rxres, rx);                    \
  623.     (void)ReREFCNT_inc(rx)
  624.  
  625. #define POPSUBST(cx) cx = &cxstack[cxstack_ix--];            \
  626.     rxres_free(&cx->sb_rxres);                    \
  627.     ReREFCNT_dec(cx->sb_rx)
  628.  
  629. struct context {
  630.     union {
  631.     struct block    cx_blk;
  632.     struct subst    cx_subst;
  633.     } cx_u;
  634. };
  635. #define cx_type cx_u.cx_subst.sbu_type
  636.  
  637. #define CXTYPEMASK    0xff
  638. #define CXt_NULL    0
  639. #define CXt_SUB        1
  640. #define CXt_EVAL    2
  641. #define CXt_LOOP    3
  642. #define CXt_SUBST    4
  643. #define CXt_BLOCK    5
  644. #define CXt_FORMAT    6
  645. #define CXt_GIVEN    7
  646. #define CXt_WHEN    8
  647.  
  648. /* private flags for CXt_SUB and CXt_NULL */
  649. #define CXp_MULTICALL    0x00000400    /* part of a multicall (so don't
  650.                        tear down context on exit). */ 
  651.  
  652. /* private flags for CXt_EVAL */
  653. #define CXp_REAL    0x00000100    /* truly eval'', not a lookalike */
  654. #define CXp_TRYBLOCK    0x00000200    /* eval{}, not eval'' or similar */
  655.  
  656. /* private flags for CXt_LOOP */
  657. #define CXp_FOREACH    0x00000200    /* a foreach loop */
  658. #define CXp_FOR_DEF    0x00000400    /* foreach using $_ */
  659. #ifdef USE_ITHREADS
  660. #  define CXp_PADVAR    0x00000100    /* itervar lives on pad, iterdata
  661.                        has pad offset; if not set,
  662.                        iterdata holds GV* */
  663. #  define CxPADLOOP(c)    (((c)->cx_type & (CXt_LOOP|CXp_PADVAR))        \
  664.              == (CXt_LOOP|CXp_PADVAR))
  665. #endif
  666.  
  667. #define CxTYPE(c)    ((c)->cx_type & CXTYPEMASK)
  668. #define CxMULTICALL(c)    (((c)->cx_type & CXp_MULTICALL)            \
  669.              == CXp_MULTICALL)
  670. #define CxREALEVAL(c)    (((c)->cx_type & (CXt_EVAL|CXp_REAL))        \
  671.              == (CXt_EVAL|CXp_REAL))
  672. #define CxTRYBLOCK(c)    (((c)->cx_type & (CXt_EVAL|CXp_TRYBLOCK))    \
  673.              == (CXt_EVAL|CXp_TRYBLOCK))
  674. #define CxFOREACH(c)    (((c)->cx_type & (CXt_LOOP|CXp_FOREACH))    \
  675.                          == (CXt_LOOP|CXp_FOREACH))
  676. #define CxFOREACHDEF(c)    (((c)->cx_type & (CXt_LOOP|CXp_FOREACH|CXp_FOR_DEF))\
  677.              == (CXt_LOOP|CXp_FOREACH|CXp_FOR_DEF))
  678.  
  679. #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
  680.  
  681. /* 
  682. =head1 "Gimme" Values
  683. */
  684.  
  685. /*
  686. =for apidoc AmU||G_SCALAR
  687. Used to indicate scalar context.  See C<GIMME_V>, C<GIMME>, and
  688. L<perlcall>.
  689.  
  690. =for apidoc AmU||G_ARRAY
  691. Used to indicate list context.  See C<GIMME_V>, C<GIMME> and
  692. L<perlcall>.
  693.  
  694. =for apidoc AmU||G_VOID
  695. Used to indicate void context.  See C<GIMME_V> and L<perlcall>.
  696.  
  697. =for apidoc AmU||G_DISCARD
  698. Indicates that arguments returned from a callback should be discarded.  See
  699. L<perlcall>.
  700.  
  701. =for apidoc AmU||G_EVAL
  702.  
  703. Used to force a Perl C<eval> wrapper around a callback.  See
  704. L<perlcall>.
  705.  
  706. =for apidoc AmU||G_NOARGS
  707.  
  708. Indicates that no arguments are being sent to a callback.  See
  709. L<perlcall>.
  710.  
  711. =cut
  712. */
  713.  
  714. #define G_SCALAR    0
  715. #define G_ARRAY        1
  716. #define G_VOID        128    /* skip this bit when adding flags below */
  717.  
  718. /* extra flags for Perl_call_* routines */
  719. #define G_DISCARD    2    /* Call FREETMPS.
  720.                    Don't change this without consulting the
  721.                    hash actions codes defined in hv.h */
  722. #define G_EVAL        4    /* Assume eval {} around subroutine call. */
  723. #define G_NOARGS    8    /* Don't construct a @_ array. */
  724. #define G_KEEPERR      16    /* Append errors to $@, don't overwrite it */
  725. #define G_NODEBUG      32    /* Disable debugging at toplevel.  */
  726. #define G_METHOD       64       /* Calling method. */
  727. #define G_FAKINGEVAL  256    /* Faking an eval context for call_sv or
  728.                    fold_constants. */
  729.  
  730. /* flag bits for PL_in_eval */
  731. #define EVAL_NULL    0    /* not in an eval */
  732. #define EVAL_INEVAL    1    /* some enclosing scope is an eval */
  733. #define EVAL_WARNONLY    2    /* used by yywarn() when calling yyerror() */
  734. #define EVAL_KEEPERR    4    /* set by Perl_call_sv if G_KEEPERR */
  735. #define EVAL_INREQUIRE    8    /* The code is being required. */
  736.  
  737. /* Support for switching (stack and block) contexts.
  738.  * This ensures magic doesn't invalidate local stack and cx pointers.
  739.  */
  740.  
  741. #define PERLSI_UNKNOWN        -1
  742. #define PERLSI_UNDEF        0
  743. #define PERLSI_MAIN        1
  744. #define PERLSI_MAGIC        2
  745. #define PERLSI_SORT        3
  746. #define PERLSI_SIGNAL        4
  747. #define PERLSI_OVERLOAD        5
  748. #define PERLSI_DESTROY        6
  749. #define PERLSI_WARNHOOK        7
  750. #define PERLSI_DIEHOOK        8
  751. #define PERLSI_REQUIRE        9
  752.  
  753. struct stackinfo {
  754.     AV *        si_stack;    /* stack for current runlevel */
  755.     PERL_CONTEXT *    si_cxstack;    /* context stack for runlevel */
  756.     struct stackinfo *    si_prev;
  757.     struct stackinfo *    si_next;
  758.     I32            si_cxix;    /* current context index */
  759.     I32            si_cxmax;    /* maximum allocated index */
  760.     I32            si_type;    /* type of runlevel */
  761.     I32            si_markoff;    /* offset where markstack begins for us.
  762.                      * currently used only with DEBUGGING,
  763.                      * but not #ifdef-ed for bincompat */
  764. };
  765.  
  766. typedef struct stackinfo PERL_SI;
  767.  
  768. #define cxstack        (PL_curstackinfo->si_cxstack)
  769. #define cxstack_ix    (PL_curstackinfo->si_cxix)
  770. #define cxstack_max    (PL_curstackinfo->si_cxmax)
  771.  
  772. #ifdef DEBUGGING
  773. #  define    SET_MARK_OFFSET \
  774.     PL_curstackinfo->si_markoff = PL_markstack_ptr - PL_markstack
  775. #else
  776. #  define    SET_MARK_OFFSET NOOP
  777. #endif
  778.  
  779. #define PUSHSTACKi(type) \
  780.     STMT_START {                            \
  781.     PERL_SI *next = PL_curstackinfo->si_next;            \
  782.     if (!next) {                            \
  783.         next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1);    \
  784.         next->si_prev = PL_curstackinfo;                \
  785.         PL_curstackinfo->si_next = next;                \
  786.     }                                \
  787.     next->si_type = type;                        \
  788.     next->si_cxix = -1;                        \
  789.     AvFILLp(next->si_stack) = 0;                    \
  790.     SWITCHSTACK(PL_curstack,next->si_stack);            \
  791.     PL_curstackinfo = next;                        \
  792.     SET_MARK_OFFSET;                        \
  793.     } STMT_END
  794.  
  795. #define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)
  796.  
  797. /* POPSTACK works with PL_stack_sp, so it may need to be bracketed by
  798.  * PUTBACK/SPAGAIN to flush/refresh any local SP that may be active */
  799. #define POPSTACK \
  800.     STMT_START {                            \
  801.     dSP;                                \
  802.     PERL_SI * const prev = PL_curstackinfo->si_prev;        \
  803.     if (!prev) {                            \
  804.         PerlIO_printf(Perl_error_log, "panic: POPSTACK\n");        \
  805.         my_exit(1);                            \
  806.     }                                \
  807.     SWITCHSTACK(PL_curstack,prev->si_stack);            \
  808.     /* don't free prev here, free them all at the END{} */        \
  809.     PL_curstackinfo = prev;                        \
  810.     } STMT_END
  811.  
  812. #define POPSTACK_TO(s) \
  813.     STMT_START {                            \
  814.     while (PL_curstack != s) {                    \
  815.         dounwind(-1);                        \
  816.         POPSTACK;                            \
  817.     }                                \
  818.     } STMT_END
  819.  
  820. #define IN_PERL_COMPILETIME    (PL_curcop == &PL_compiling)
  821. #define IN_PERL_RUNTIME        (PL_curcop != &PL_compiling)
  822.  
  823. /*
  824. =head1 Multicall Functions
  825.  
  826. =for apidoc Ams||dMULTICALL
  827. Declare local variables for a multicall. See L<perlcall/Lightweight Callbacks>.
  828.  
  829. =for apidoc Ams||PUSH_MULTICALL
  830. Opening bracket for a lightweight callback.
  831. See L<perlcall/Lightweight Callbacks>.
  832.  
  833. =for apidoc Ams||MULTICALL
  834. Make a lightweight callback. See L<perlcall/Lightweight Callbacks>.
  835.  
  836. =for apidoc Ams||POP_MULTICALL
  837. Closing bracket for a lightweight callback.
  838. See L<perlcall/Lightweight Callbacks>.
  839.  
  840. =cut
  841. */
  842.  
  843. #define dMULTICALL \
  844.     SV **newsp;            /* set by POPBLOCK */            \
  845.     PERL_CONTEXT *cx;                            \
  846.     CV *multicall_cv;                            \
  847.     OP *multicall_cop;                            \
  848.     bool multicall_oldcatch;                         \
  849.     U8 hasargs = 0        /* used by PUSHSUB */
  850.  
  851. #define PUSH_MULTICALL(the_cv) \
  852.     STMT_START {                            \
  853.     CV * const _nOnclAshIngNamE_ = the_cv;                \
  854.     CV * const cv = _nOnclAshIngNamE_;                \
  855.     AV * const padlist = CvPADLIST(cv);                \
  856.     ENTER;                                \
  857.      multicall_oldcatch = CATCH_GET;                    \
  858.     SAVETMPS; SAVEVPTR(PL_op);                    \
  859.     CATCH_SET(TRUE);                        \
  860.     PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp);        \
  861.     PUSHSUB(cx);                            \
  862.     if (++CvDEPTH(cv) >= 2) {                    \
  863.         PERL_STACK_OVERFLOW_CHECK();                \
  864.         Perl_pad_push(aTHX_ padlist, CvDEPTH(cv));            \
  865.     }                                \
  866.     SAVECOMPPAD();                            \
  867.     PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));            \
  868.     multicall_cv = cv;                        \
  869.     multicall_cop = CvSTART(cv);                    \
  870.     } STMT_END
  871.  
  872. #define MULTICALL \
  873.     STMT_START {                            \
  874.     PL_op = multicall_cop;                        \
  875.     CALLRUNOPS(aTHX);                        \
  876.     } STMT_END
  877.  
  878. #define POP_MULTICALL \
  879.     STMT_START {                            \
  880.     LEAVESUB(multicall_cv);                        \
  881.     CvDEPTH(multicall_cv)--;                    \
  882.     POPBLOCK(cx,PL_curpm);                        \
  883.     CATCH_SET(multicall_oldcatch);                    \
  884.     LEAVE;                                \
  885.     } STMT_END
  886.  
  887. /*
  888.  * Local variables:
  889.  * c-indentation-style: bsd
  890.  * c-basic-offset: 4
  891.  * indent-tabs-mode: t
  892.  * End:
  893.  *
  894.  * ex: set ts=8 sts=4 sw=4 noet:
  895.  */
  896.