source: trunk/third/perl/scope.h @ 17035

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