home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 December / PCpro_2006_12.ISO / ossdvd / server / Perl2 / lib / core / scope.h < prev    next >
Encoding:
C/C++ Source or Header  |  2002-06-19  |  13.0 KB  |  403 lines
  1. /*    scope.h
  2.  *
  3.  *    Copyright (c) 1997-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. #define SAVEt_ITEM        0
  11. #define SAVEt_SV        1
  12. #define SAVEt_AV        2
  13. #define SAVEt_HV        3
  14. #define SAVEt_INT        4
  15. #define SAVEt_LONG        5
  16. #define SAVEt_I32        6
  17. #define SAVEt_IV        7
  18. #define SAVEt_SPTR        8
  19. #define SAVEt_APTR        9
  20. #define SAVEt_HPTR        10
  21. #define SAVEt_PPTR        11
  22. #define SAVEt_NSTAB        12
  23. #define SAVEt_SVREF        13
  24. #define SAVEt_GP        14
  25. #define SAVEt_FREESV        15
  26. #define SAVEt_FREEOP        16
  27. #define SAVEt_FREEPV        17
  28. #define SAVEt_CLEARSV        18
  29. #define SAVEt_DELETE        19
  30. #define SAVEt_DESTRUCTOR    20
  31. #define SAVEt_REGCONTEXT    21
  32. #define SAVEt_STACK_POS        22
  33. #define SAVEt_I16        23
  34. #define SAVEt_AELEM        24
  35. #define SAVEt_HELEM        25
  36. #define SAVEt_OP        26
  37. #define SAVEt_HINTS        27
  38. #define SAVEt_ALLOC        28
  39. #define SAVEt_GENERIC_SVREF    29
  40. #define SAVEt_DESTRUCTOR_X    30
  41. #define SAVEt_VPTR        31
  42. #define SAVEt_I8        32
  43. #define SAVEt_COMPPAD        33
  44. #define SAVEt_GENERIC_PVREF    34
  45. #define SAVEt_PADSV        35
  46. #define SAVEt_MORTALIZESV    36
  47. #define SAVEt_SHARED_PVREF    37
  48.  
  49. #ifndef SCOPE_SAVES_SIGNAL_MASK
  50. #define SCOPE_SAVES_SIGNAL_MASK 0
  51. #endif
  52.  
  53. #define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow()
  54. #define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i))
  55. #define SSPUSHLONG(i) (PL_savestack[PL_savestack_ix++].any_long = (long)(i))
  56. #define SSPUSHIV(i) (PL_savestack[PL_savestack_ix++].any_iv = (IV)(i))
  57. #define SSPUSHPTR(p) (PL_savestack[PL_savestack_ix++].any_ptr = (void*)(p))
  58. #define SSPUSHDPTR(p) (PL_savestack[PL_savestack_ix++].any_dptr = (p))
  59. #define SSPUSHDXPTR(p) (PL_savestack[PL_savestack_ix++].any_dxptr = (p))
  60. #define SSPOPINT (PL_savestack[--PL_savestack_ix].any_i32)
  61. #define SSPOPLONG (PL_savestack[--PL_savestack_ix].any_long)
  62. #define SSPOPIV (PL_savestack[--PL_savestack_ix].any_iv)
  63. #define SSPOPPTR (PL_savestack[--PL_savestack_ix].any_ptr)
  64. #define SSPOPDPTR (PL_savestack[--PL_savestack_ix].any_dptr)
  65. #define SSPOPDXPTR (PL_savestack[--PL_savestack_ix].any_dxptr)
  66.  
  67. /*
  68. =head1 Callback Functions
  69.  
  70. =for apidoc Ams||SAVETMPS
  71. Opening bracket for temporaries on a callback.  See C<FREETMPS> and
  72. L<perlcall>.
  73.  
  74. =for apidoc Ams||FREETMPS
  75. Closing bracket for temporaries on a callback.  See C<SAVETMPS> and
  76. L<perlcall>.
  77.  
  78. =for apidoc Ams||ENTER
  79. Opening bracket on a callback.  See C<LEAVE> and L<perlcall>.
  80.  
  81. =for apidoc Ams||LEAVE
  82. Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
  83.  
  84. =cut
  85. */
  86.  
  87. #define SAVETMPS save_int((int*)&PL_tmps_floor), PL_tmps_floor = PL_tmps_ix
  88. #define FREETMPS if (PL_tmps_ix > PL_tmps_floor) free_tmps()
  89.  
  90. #ifdef DEBUGGING
  91. #define ENTER                            \
  92.     STMT_START {                        \
  93.     push_scope();                        \
  94.     DEBUG_l(WITH_THR(Perl_deb(aTHX_ "ENTER scope %ld at %s:%d\n",    \
  95.             PL_scopestack_ix, __FILE__, __LINE__)));    \
  96.     } STMT_END
  97. #define LEAVE                            \
  98.     STMT_START {                        \
  99.     DEBUG_l(WITH_THR(Perl_deb(aTHX_ "LEAVE scope %ld at %s:%d\n",    \
  100.             PL_scopestack_ix, __FILE__, __LINE__)));    \
  101.     pop_scope();                        \
  102.     } STMT_END
  103. #else
  104. #define ENTER push_scope()
  105. #define LEAVE pop_scope()
  106. #endif
  107. #define LEAVE_SCOPE(old) if (PL_savestack_ix > old) leave_scope(old)
  108.  
  109. /*
  110.  * Not using SOFT_CAST on SAVESPTR, SAVEGENERICSV and SAVEFREESV
  111.  * because these are used for several kinds of pointer values
  112.  */
  113. #define SAVEI8(i)    save_I8(SOFT_CAST(I8*)&(i))
  114. #define SAVEI16(i)    save_I16(SOFT_CAST(I16*)&(i))
  115. #define SAVEI32(i)    save_I32(SOFT_CAST(I32*)&(i))
  116. #define SAVEINT(i)    save_int(SOFT_CAST(int*)&(i))
  117. #define SAVEIV(i)    save_iv(SOFT_CAST(IV*)&(i))
  118. #define SAVELONG(l)    save_long(SOFT_CAST(long*)&(l))
  119. #define SAVESPTR(s)    save_sptr((SV**)&(s))
  120. #define SAVEPPTR(s)    save_pptr(SOFT_CAST(char**)&(s))
  121. #define SAVEVPTR(s)    save_vptr((void*)&(s))
  122. #define SAVEPADSV(s)    save_padsv(s)
  123. #define SAVEFREESV(s)    save_freesv((SV*)(s))
  124. #define SAVEMORTALIZESV(s)    save_mortalizesv((SV*)(s))
  125. #define SAVEFREEOP(o)    save_freeop(SOFT_CAST(OP*)(o))
  126. #define SAVEFREEPV(p)    save_freepv(SOFT_CAST(char*)(p))
  127. #define SAVECLEARSV(sv)    save_clearsv(SOFT_CAST(SV**)&(sv))
  128. #define SAVEGENERICSV(s)    save_generic_svref((SV**)&(s))
  129. #define SAVEGENERICPV(s)    save_generic_pvref((char**)&(s))
  130. #define SAVESHAREDPV(s)        save_shared_pvref((char**)&(s))
  131. #define SAVEDELETE(h,k,l) \
  132.       save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l))
  133. #define SAVEDESTRUCTOR(f,p) \
  134.       save_destructor((DESTRUCTORFUNC_NOCONTEXT_t)(f), SOFT_CAST(void*)(p))
  135.  
  136. #define SAVEDESTRUCTOR_X(f,p) \
  137.       save_destructor_x((DESTRUCTORFUNC_t)(f), SOFT_CAST(void*)(p))
  138.  
  139. #define SAVESTACK_POS() \
  140.     STMT_START {                \
  141.     SSCHECK(2);                \
  142.     SSPUSHINT(PL_stack_sp - PL_stack_base);    \
  143.     SSPUSHINT(SAVEt_STACK_POS);        \
  144.     } STMT_END
  145.  
  146. #define SAVEOP()    save_op()
  147.  
  148. #define SAVEHINTS() \
  149.     STMT_START {                \
  150.     if (PL_hints & HINT_LOCALIZE_HH)    \
  151.         save_hints();            \
  152.     else {                    \
  153.         SSCHECK(2);                \
  154.         SSPUSHINT(PL_hints);        \
  155.         SSPUSHINT(SAVEt_HINTS);        \
  156.     }                    \
  157.     } STMT_END
  158.  
  159. #define SAVECOMPPAD() \
  160.     STMT_START {                        \
  161.     if (PL_comppad && PL_curpad == AvARRAY(PL_comppad)) {    \
  162.         SSCHECK(2);                        \
  163.         SSPUSHPTR((SV*)PL_comppad);                \
  164.         SSPUSHINT(SAVEt_COMPPAD);                \
  165.     }                            \
  166.     else {                            \
  167.         SAVEVPTR(PL_curpad);                \
  168.         SAVESPTR(PL_comppad);                \
  169.     }                            \
  170.     } STMT_END
  171.  
  172. #ifdef USE_ITHREADS
  173. #  define SAVECOPSTASH(c)    SAVEPPTR(CopSTASHPV(c))
  174. #  define SAVECOPSTASH_FREE(c)    SAVESHAREDPV(CopSTASHPV(c))
  175. #  define SAVECOPFILE(c)    SAVEPPTR(CopFILE(c))
  176. #  define SAVECOPFILE_FREE(c)    SAVESHAREDPV(CopFILE(c))
  177. #else
  178. #  define SAVECOPSTASH(c)    SAVESPTR(CopSTASH(c))
  179. #  define SAVECOPSTASH_FREE(c)    SAVECOPSTASH(c)    /* XXX not refcounted */
  180. #  define SAVECOPFILE(c)    SAVESPTR(CopFILEGV(c))
  181. #  define SAVECOPFILE_FREE(c)    SAVEGENERICSV(CopFILEGV(c))
  182. #endif
  183.  
  184. #define SAVECOPLINE(c)        SAVEI16(CopLINE(c))
  185.  
  186. /* SSNEW() temporarily allocates a specified number of bytes of data on the
  187.  * savestack.  It returns an integer index into the savestack, because a
  188.  * pointer would get broken if the savestack is moved on reallocation.
  189.  * SSNEWa() works like SSNEW(), but also aligns the data to the specified
  190.  * number of bytes.  MEM_ALIGNBYTES is perhaps the most useful.  The
  191.  * alignment will be preserved therough savestack reallocation *only* if
  192.  * realloc returns data aligned to a size divisible by `align'!
  193.  *
  194.  * SSPTR() converts the index returned by SSNEW/SSNEWa() into a pointer.
  195.  */
  196.  
  197. #define SSNEW(size)             Perl_save_alloc(aTHX_ (size), 0)
  198. #define SSNEWt(n,t)             SSNEW((n)*sizeof(t))
  199. #define SSNEWa(size,align)    Perl_save_alloc(aTHX_ (size), \
  200.     (align - ((int)((caddr_t)&PL_savestack[PL_savestack_ix]) % align)) % align)
  201. #define SSNEWat(n,t,align)    SSNEWa((n)*sizeof(t), align)
  202.  
  203. #define SSPTR(off,type)         ((type)  ((char*)PL_savestack + off))
  204. #define SSPTRt(off,type)        ((type*) ((char*)PL_savestack + off))
  205.  
  206. /* A jmpenv packages the state required to perform a proper non-local jump.
  207.  * Note that there is a start_env initialized when perl starts, and top_env
  208.  * points to this initially, so top_env should always be non-null.
  209.  *
  210.  * Existence of a non-null top_env->je_prev implies it is valid to call
  211.  * longjmp() at that runlevel (we make sure start_env.je_prev is always
  212.  * null to ensure this).
  213.  *
  214.  * je_mustcatch, when set at any runlevel to TRUE, means eval ops must
  215.  * establish a local jmpenv to handle exception traps.  Care must be taken
  216.  * to restore the previous value of je_mustcatch before exiting the
  217.  * stack frame iff JMPENV_PUSH was not called in that stack frame.
  218.  * GSAR 97-03-27
  219.  */
  220.  
  221. struct jmpenv {
  222.     struct jmpenv *    je_prev;
  223.     Sigjmp_buf        je_buf;        /* only for use if !je_throw */
  224.     int            je_ret;        /* last exception thrown */
  225.     bool        je_mustcatch;    /* need to call longjmp()? */
  226. #ifdef PERL_FLEXIBLE_EXCEPTIONS
  227.     void        (*je_throw)(int v); /* last for bincompat */
  228.     bool        je_noset;    /* no need for setjmp() */
  229. #endif
  230. };
  231.  
  232. typedef struct jmpenv JMPENV;
  233.  
  234. #ifdef OP_IN_REGISTER
  235. #define OP_REG_TO_MEM    PL_opsave = op
  236. #define OP_MEM_TO_REG    op = PL_opsave
  237. #else
  238. #define OP_REG_TO_MEM    NOOP
  239. #define OP_MEM_TO_REG    NOOP
  240. #endif
  241.  
  242. /*
  243.  * How to build the first jmpenv.
  244.  *
  245.  * top_env needs to be non-zero. It points to an area
  246.  * in which longjmp() stuff is stored, as C callstack
  247.  * info there at least is thread specific this has to
  248.  * be per-thread. Otherwise a 'die' in a thread gives
  249.  * that thread the C stack of last thread to do an eval {}!
  250.  */
  251.  
  252. #define JMPENV_BOOTSTRAP \
  253.     STMT_START {                \
  254.     Zero(&PL_start_env, 1, JMPENV);        \
  255.     PL_start_env.je_ret = -1;        \
  256.     PL_start_env.je_mustcatch = TRUE;    \
  257.     PL_top_env = &PL_start_env;        \
  258.     } STMT_END
  259.  
  260. #ifdef PERL_FLEXIBLE_EXCEPTIONS
  261.  
  262. /*
  263.  * These exception-handling macros are split up to
  264.  * ease integration with C++ exceptions.
  265.  *
  266.  * To use C++ try+catch to catch Perl exceptions, an extension author
  267.  * needs to first write an extern "C" function to throw an appropriate
  268.  * exception object; typically it will be or contain an integer,
  269.  * because Perl's internals use integers to track exception types:
  270.  *    extern "C" { static void thrower(int i) { throw i; } }
  271.  *
  272.  * Then (as shown below) the author needs to use, not the simple
  273.  * JMPENV_PUSH, but several of its constitutent macros, to arrange for
  274.  * the Perl internals to call thrower() rather than longjmp() to
  275.  * report exceptions:
  276.  *
  277.  *    dJMPENV;
  278.  *    JMPENV_PUSH_INIT(thrower);
  279.  *    try {
  280.  *        ... stuff that may throw exceptions ...
  281.  *    }
  282.  *    catch (int why) {  // or whatever matches thrower()
  283.  *        JMPENV_POST_CATCH;
  284.  *        EXCEPT_SET(why);
  285.  *        switch (why) {
  286.  *          ... // handle various Perl exception codes
  287.  *        }
  288.  *    }
  289.  *    JMPENV_POP;  // don't forget this!
  290.  */
  291.  
  292. /*
  293.  * Function that catches/throws, and its callback for the
  294.  *  body of protected processing.
  295.  */
  296. typedef void *(CPERLscope(*protect_body_t)) (pTHX_ va_list);
  297. typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env,
  298.                          int *, protect_body_t, ...);
  299.  
  300. #define dJMPENV    JMPENV cur_env;    \
  301.         volatile JMPENV *pcur_env = ((cur_env.je_noset = 0),&cur_env)
  302.  
  303. #define JMPENV_PUSH_INIT_ENV(ce,THROWFUNC) \
  304.     STMT_START {                    \
  305.     (ce).je_throw = (THROWFUNC);            \
  306.     (ce).je_ret = -1;                \
  307.     (ce).je_mustcatch = FALSE;            \
  308.     (ce).je_prev = PL_top_env;            \
  309.     PL_top_env = &(ce);                \
  310.     OP_REG_TO_MEM;                    \
  311.     } STMT_END
  312.  
  313. #define JMPENV_PUSH_INIT(THROWFUNC) JMPENV_PUSH_INIT_ENV(*(JMPENV*)pcur_env,THROWFUNC)
  314.  
  315. #define JMPENV_POST_CATCH_ENV(ce) \
  316.     STMT_START {                    \
  317.     OP_MEM_TO_REG;                    \
  318.     PL_top_env = &(ce);                \
  319.     } STMT_END
  320.  
  321. #define JMPENV_POST_CATCH JMPENV_POST_CATCH_ENV(*(JMPENV*)pcur_env)
  322.  
  323. #define JMPENV_PUSH_ENV(ce,v) \
  324.     STMT_START {                        \
  325.     if (!(ce).je_noset) {                    \
  326.         DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n",    \
  327.                  ce, PL_top_env));            \
  328.         JMPENV_PUSH_INIT_ENV(ce,NULL);            \
  329.         EXCEPT_SET_ENV(ce,PerlProc_setjmp((ce).je_buf, SCOPE_SAVES_SIGNAL_MASK));\
  330.         (ce).je_noset = 1;                    \
  331.     }                            \
  332.     else                            \
  333.         EXCEPT_SET_ENV(ce,0);                \
  334.     JMPENV_POST_CATCH_ENV(ce);                \
  335.     (v) = EXCEPT_GET_ENV(ce);                \
  336.     } STMT_END
  337.  
  338. #define JMPENV_PUSH(v) JMPENV_PUSH_ENV(*(JMPENV*)pcur_env,v)
  339.  
  340. #define JMPENV_POP_ENV(ce) \
  341.     STMT_START {                        \
  342.     if (PL_top_env == &(ce))                \
  343.         PL_top_env = (ce).je_prev;                \
  344.     } STMT_END
  345.  
  346. #define JMPENV_POP  JMPENV_POP_ENV(*(JMPENV*)pcur_env)
  347.  
  348. #define JMPENV_JUMP(v) \
  349.     STMT_START {                        \
  350.     OP_REG_TO_MEM;                        \
  351.     if (PL_top_env->je_prev) {                \
  352.         if (PL_top_env->je_throw)                \
  353.         PL_top_env->je_throw(v);            \
  354.         else                        \
  355.         PerlProc_longjmp(PL_top_env->je_buf, (v));    \
  356.     }                            \
  357.     if ((v) == 2)                        \
  358.         PerlProc_exit(STATUS_NATIVE_EXPORT);        \
  359.     PerlIO_printf(Perl_error_log, "panic: top_env\n");    \
  360.     PerlProc_exit(1);                    \
  361.     } STMT_END
  362.  
  363. #define EXCEPT_GET_ENV(ce)    ((ce).je_ret)
  364. #define EXCEPT_GET        EXCEPT_GET_ENV(*(JMPENV*)pcur_env)
  365. #define EXCEPT_SET_ENV(ce,v)    ((ce).je_ret = (v))
  366. #define EXCEPT_SET(v)        EXCEPT_SET_ENV(*(JMPENV*)pcur_env,v)
  367.  
  368. #else /* !PERL_FLEXIBLE_EXCEPTIONS */
  369.  
  370. #define dJMPENV        JMPENV cur_env
  371.  
  372. #define JMPENV_PUSH(v) \
  373.     STMT_START {                            \
  374.     DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n",    \
  375.              &cur_env, PL_top_env));            \
  376.     cur_env.je_prev = PL_top_env;                    \
  377.     OP_REG_TO_MEM;                            \
  378.     cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK);        \
  379.     OP_MEM_TO_REG;                            \
  380.     PL_top_env = &cur_env;                        \
  381.     cur_env.je_mustcatch = FALSE;                    \
  382.     (v) = cur_env.je_ret;                        \
  383.     } STMT_END
  384.  
  385. #define JMPENV_POP \
  386.     STMT_START { PL_top_env = cur_env.je_prev; } STMT_END
  387.  
  388. #define JMPENV_JUMP(v) \
  389.     STMT_START {                        \
  390.     OP_REG_TO_MEM;                        \
  391.     if (PL_top_env->je_prev)                \
  392.         PerlProc_longjmp(PL_top_env->je_buf, (v));        \
  393.     if ((v) == 2)                        \
  394.         PerlProc_exit(STATUS_NATIVE_EXPORT);        \
  395.     PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");    \
  396.     PerlProc_exit(1);                    \
  397.     } STMT_END
  398.  
  399. #endif /* PERL_FLEXIBLE_EXCEPTIONS */
  400.  
  401. #define CATCH_GET        (PL_top_env->je_mustcatch)
  402. #define CATCH_SET(v)        (PL_top_env->je_mustcatch = (v))
  403.