ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/staticperl/perl/scope.h
Revision: 1.1
Committed: Thu Jun 30 14:26:42 2005 UTC (21 years, 3 months ago) by root
Content type: text/plain
Branch: MAIN
CVS Tags: PERL-5-8-7, HEAD
Branch point for: PERL
Log Message:
*** empty log message ***

File Contents

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