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

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