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