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