home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / CORE / cop.h < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-10  |  8.0 KB  |  278 lines
  1. /*    cop.h
  2.  *
  3.  *    Copyright (c) 1991-1997, 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.     HV *    cop_stash;    /* package line was compiled in */
  14.     GV *    cop_filegv;    /* file the following line # is from */
  15.     U32        cop_seq;    /* parse sequence number */
  16.     I32        cop_arybase;    /* array base this line was compiled with */
  17.     line_t      cop_line;       /* line # of this command */
  18. };
  19.  
  20. #define Nullcop Null(COP*)
  21.  
  22. /*
  23.  * Here we have some enormously heavy (or at least ponderous) wizardry.
  24.  */
  25.  
  26. /* subroutine context */
  27. struct block_sub {
  28.     CV *    cv;
  29.     GV *    gv;
  30.     GV *    dfoutgv;
  31.     AV *    savearray;
  32.     AV *    argarray;
  33.     U16        olddepth;
  34.     U8        hasargs;
  35. };
  36.  
  37. #define PUSHSUB(cx)                            \
  38.     cx->blk_sub.cv = cv;                        \
  39.     cx->blk_sub.olddepth = CvDEPTH(cv);                \
  40.     cx->blk_sub.hasargs = hasargs;
  41.  
  42. #define PUSHFORMAT(cx)                            \
  43.     cx->blk_sub.cv = cv;                        \
  44.     cx->blk_sub.gv = gv;                        \
  45.     cx->blk_sub.hasargs = 0;                    \
  46.     cx->blk_sub.dfoutgv = defoutgv;                    \
  47.     (void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
  48.  
  49. #define POPSUB(cx)                            \
  50.     { struct block_sub cxsub;                    \
  51.       POPSUB1(cx);                            \
  52.       POPSUB2(); }
  53.  
  54. #define POPSUB1(cx)                            \
  55.     cxsub = cx->blk_sub;    /* because DESTROY may clobber *cx */
  56.  
  57. #define POPSUB2()                            \
  58.     if (cxsub.hasargs) {                        \
  59.         /* put back old @_ */                    \
  60.         SvREFCNT_dec(GvAV(defgv));                    \
  61.         GvAV(defgv) = cxsub.savearray;                \
  62.         /* destroy arg array */                    \
  63.         av_clear(cxsub.argarray);                    \
  64.         AvREAL_off(cxsub.argarray);                    \
  65.     }                                \
  66.     if (cxsub.cv) {                            \
  67.         if (!(CvDEPTH(cxsub.cv) = cxsub.olddepth))            \
  68.         SvREFCNT_dec(cxsub.cv);                    \
  69.     }
  70.  
  71. #define POPFORMAT(cx)                            \
  72.     setdefout(cx->blk_sub.dfoutgv);                    \
  73.     SvREFCNT_dec(cx->blk_sub.dfoutgv);
  74.  
  75. /* eval context */
  76. struct block_eval {
  77.     I32        old_in_eval;
  78.     I32        old_op_type;
  79.     char *    old_name;
  80.     OP *    old_eval_root;
  81.     SV *    cur_text;
  82. };
  83.  
  84. #define PUSHEVAL(cx,n,fgv)                        \
  85.     cx->blk_eval.old_in_eval = in_eval;                \
  86.     cx->blk_eval.old_op_type = op->op_type;                \
  87.     cx->blk_eval.old_name = n;                    \
  88.     cx->blk_eval.old_eval_root = eval_root;                \
  89.     cx->blk_eval.cur_text = linestr;
  90.  
  91. #define POPEVAL(cx)                            \
  92.     in_eval = cx->blk_eval.old_in_eval;                \
  93.     optype = cx->blk_eval.old_op_type;                \
  94.     eval_root = cx->blk_eval.old_eval_root;
  95.  
  96. /* loop context */
  97. struct block_loop {
  98.     char *    label;
  99.     I32        resetsp;
  100.     OP *    redo_op;
  101.     OP *    next_op;
  102.     OP *    last_op;
  103.     SV **    itervar;
  104.     SV *    itersave;
  105.     SV *    iterlval;
  106.     AV *    iterary;
  107.     I32        iterix;
  108. };
  109.  
  110. #define PUSHLOOP(cx, ivar, s)                        \
  111.     cx->blk_loop.label = curcop->cop_label;                \
  112.     cx->blk_loop.resetsp = s - stack_base;                \
  113.     cx->blk_loop.redo_op = cLOOP->op_redoop;            \
  114.     cx->blk_loop.next_op = cLOOP->op_nextop;            \
  115.     cx->blk_loop.last_op = cLOOP->op_lastop;            \
  116.     if (cx->blk_loop.itervar = (ivar))                \
  117.         cx->blk_loop.itersave = SvREFCNT_inc(*cx->blk_loop.itervar);\
  118.     cx->blk_loop.iterlval = Nullsv;                    \
  119.     cx->blk_loop.iterary = Nullav;                    \
  120.     cx->blk_loop.iterix = -1;
  121.  
  122. #define POPLOOP(cx)                            \
  123.     { struct block_loop cxloop;                    \
  124.       POPLOOP1(cx);                            \
  125.       POPLOOP2(); }
  126.  
  127. #define POPLOOP1(cx)                            \
  128.     cxloop = cx->blk_loop;    /* because DESTROY may clobber *cx */    \
  129.     newsp = stack_base + cxloop.resetsp;
  130.  
  131. #define POPLOOP2()                            \
  132.     SvREFCNT_dec(cxloop.iterlval);                    \
  133.     if (cxloop.itervar) {                        \
  134.         SvREFCNT_dec(*cxloop.itervar);                \
  135.         *cxloop.itervar = cxloop.itersave;                \
  136.     }                                \
  137.     if (cxloop.iterary && cxloop.iterary != curstack)        \
  138.         SvREFCNT_dec(cxloop.iterary);
  139.  
  140. /* context common to subroutines, evals and loops */
  141. struct block {
  142.     I32        blku_oldsp;    /* stack pointer to copy stuff down to */
  143.     COP *    blku_oldcop;    /* old curcop pointer */
  144.     I32        blku_oldretsp;    /* return stack index */
  145.     I32        blku_oldmarksp;    /* mark stack index */
  146.     I32        blku_oldscopesp;    /* scope stack index */
  147.     PMOP *    blku_oldpm;    /* values of pattern match vars */
  148.     U8        blku_gimme;    /* is this block running in list context? */
  149.  
  150.     union {
  151.     struct block_sub    blku_sub;
  152.     struct block_eval    blku_eval;
  153.     struct block_loop    blku_loop;
  154.     } blk_u;
  155. };
  156. #define blk_oldsp    cx_u.cx_blk.blku_oldsp
  157. #define blk_oldcop    cx_u.cx_blk.blku_oldcop
  158. #define blk_oldretsp    cx_u.cx_blk.blku_oldretsp
  159. #define blk_oldmarksp    cx_u.cx_blk.blku_oldmarksp
  160. #define blk_oldscopesp    cx_u.cx_blk.blku_oldscopesp
  161. #define blk_oldpm    cx_u.cx_blk.blku_oldpm
  162. #define blk_gimme    cx_u.cx_blk.blku_gimme
  163. #define blk_sub        cx_u.cx_blk.blk_u.blku_sub
  164. #define blk_eval    cx_u.cx_blk.blk_u.blku_eval
  165. #define blk_loop    cx_u.cx_blk.blk_u.blku_loop
  166.  
  167. /* Enter a block. */
  168. #define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix],        \
  169.     cx->cx_type        = t,                    \
  170.     cx->blk_oldsp        = sp - stack_base,            \
  171.     cx->blk_oldcop        = curcop,                \
  172.     cx->blk_oldmarksp    = markstack_ptr - markstack,        \
  173.     cx->blk_oldscopesp    = scopestack_ix,            \
  174.     cx->blk_oldretsp    = retstack_ix,                \
  175.     cx->blk_oldpm        = curpm,                \
  176.     cx->blk_gimme        = gimme;                \
  177.     DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Entering block %ld, type %s\n",    \
  178.             (long)cxstack_ix, block_type[t]); )
  179.  
  180. /* Exit a block (RETURN and LAST). */
  181. #define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--],            \
  182.     newsp        = stack_base + cx->blk_oldsp,            \
  183.     curcop        = cx->blk_oldcop,                \
  184.     markstack_ptr    = markstack + cx->blk_oldmarksp,        \
  185.     scopestack_ix    = cx->blk_oldscopesp,                \
  186.     retstack_ix    = cx->blk_oldretsp,                \
  187.     pm        = cx->blk_oldpm,                \
  188.     gimme        = cx->blk_gimme;                \
  189.     DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Leaving block %ld, type %s\n",        \
  190.             (long)cxstack_ix+1,block_type[cx->cx_type]); )
  191.  
  192. /* Continue a block elsewhere (NEXT and REDO). */
  193. #define TOPBLOCK(cx) cx = &cxstack[cxstack_ix],                \
  194.     stack_sp    = stack_base + cx->blk_oldsp,            \
  195.     markstack_ptr    = markstack + cx->blk_oldmarksp,        \
  196.     scopestack_ix    = cx->blk_oldscopesp,                \
  197.     retstack_ix    = cx->blk_oldretsp
  198.  
  199. /* substitution context */
  200. struct subst {
  201.     I32        sbu_iters;
  202.     I32        sbu_maxiters;
  203.     I32        sbu_safebase;
  204.     I32        sbu_oldsave;
  205.     bool    sbu_once;
  206.     bool    sbu_rxtainted;
  207.     char *    sbu_orig;
  208.     SV *    sbu_dstr;
  209.     SV *    sbu_targ;
  210.     char *    sbu_s;
  211.     char *    sbu_m;
  212.     char *    sbu_strend;
  213.     void *    sbu_rxres;
  214.     REGEXP *    sbu_rx;
  215. };
  216. #define sb_iters    cx_u.cx_subst.sbu_iters
  217. #define sb_maxiters    cx_u.cx_subst.sbu_maxiters
  218. #define sb_safebase    cx_u.cx_subst.sbu_safebase
  219. #define sb_oldsave    cx_u.cx_subst.sbu_oldsave
  220. #define sb_once        cx_u.cx_subst.sbu_once
  221. #define sb_rxtainted    cx_u.cx_subst.sbu_rxtainted
  222. #define sb_orig        cx_u.cx_subst.sbu_orig
  223. #define sb_dstr        cx_u.cx_subst.sbu_dstr
  224. #define sb_targ        cx_u.cx_subst.sbu_targ
  225. #define sb_s        cx_u.cx_subst.sbu_s
  226. #define sb_m        cx_u.cx_subst.sbu_m
  227. #define sb_strend    cx_u.cx_subst.sbu_strend
  228. #define sb_rxres    cx_u.cx_subst.sbu_rxres
  229. #define sb_rx        cx_u.cx_subst.sbu_rx
  230.  
  231. #define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix],            \
  232.     cx->sb_iters        = iters,                \
  233.     cx->sb_maxiters        = maxiters,                \
  234.     cx->sb_safebase        = safebase,                \
  235.     cx->sb_oldsave        = oldsave,                \
  236.     cx->sb_once        = once,                    \
  237.     cx->sb_rxtainted    = rxtainted,                \
  238.     cx->sb_orig        = orig,                    \
  239.     cx->sb_dstr        = dstr,                    \
  240.     cx->sb_targ        = targ,                    \
  241.     cx->sb_s        = s,                    \
  242.     cx->sb_m        = m,                    \
  243.     cx->sb_strend        = strend,                \
  244.     cx->sb_rxres        = Null(void*),                \
  245.     cx->sb_rx        = rx,                    \
  246.     cx->cx_type        = CXt_SUBST;                \
  247.     rxres_save(&cx->sb_rxres, rx)
  248.  
  249. #define POPSUBST(cx) cx = &cxstack[cxstack_ix--];            \
  250.     rxres_free(&cx->sb_rxres)
  251.  
  252. struct context {
  253.     I32        cx_type;    /* what kind of context this is */
  254.     union {
  255.     struct block    cx_blk;
  256.     struct subst    cx_subst;
  257.     } cx_u;
  258. };
  259. #define CXt_NULL    0
  260. #define CXt_SUB        1
  261. #define CXt_EVAL    2
  262. #define CXt_LOOP    3
  263. #define CXt_SUBST    4
  264. #define CXt_BLOCK    5
  265.  
  266. #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
  267.  
  268. /* "gimme" values */
  269. #define G_SCALAR    0
  270. #define G_ARRAY        1
  271. #define G_VOID        128    /* skip this bit when adding flags below */
  272.  
  273. /* extra flags for perl_call_* routines */
  274. #define G_DISCARD    2    /* Call FREETMPS. */
  275. #define G_EVAL        4    /* Assume eval {} around subroutine call. */
  276. #define G_NOARGS    8    /* Don't construct a @_ array. */
  277. #define G_KEEPERR      16    /* Append errors to $@, don't overwrite it */
  278.