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

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