diff options
| -rw-r--r-- | embed.fnc | 15 | ||||
| -rw-r--r-- | embed.h | 45 | ||||
| -rw-r--r-- | embedvar.h | 2 | ||||
| -rw-r--r-- | global.sym | 2 | ||||
| -rw-r--r-- | makedef.pl | 8 | ||||
| -rw-r--r-- | perl.c | 81 | ||||
| -rw-r--r-- | perl.h | 4 | ||||
| -rw-r--r-- | perlapi.h | 2 | ||||
| -rw-r--r-- | pod/perlapi.pod | 10 | ||||
| -rw-r--r-- | pod/perlintern.pod | 4 | ||||
| -rw-r--r-- | pp_ctl.c | 15 | ||||
| -rw-r--r-- | proto.h | 13 | ||||
| -rw-r--r-- | scope.c | 31 | ||||
| -rw-r--r-- | scope.h | 138 | ||||
| -rw-r--r-- | sv.c | 3 | ||||
| -rw-r--r-- | thrdvar.h | 3 |
16 files changed, 41 insertions, 335 deletions
@@ -904,12 +904,6 @@ Ap |void |do_pmop_dump |I32 level|PerlIO *file|PMOP *pm Ap |void |do_sv_dump |I32 level|PerlIO *file|SV *sv|I32 nest \ |I32 maxnest|bool dumpops|STRLEN pvlim Ap |void |magic_dump |MAGIC *mg -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -Ap |void* |default_protect|volatile JMPENV *je|int *excpt \ - |protect_body_t body|... -Ap |void* |vdefault_protect|volatile JMPENV *je|int *excpt \ - |protect_body_t body|va_list *args -#endif Ap |void |reginitcolors Apd |char* |sv_2pv_nolen |SV* sv Apd |char* |sv_2pvutf8_nolen|SV* sv @@ -1056,12 +1050,6 @@ s |void* |parse_body |char **env|XSINIT_t xsinit s |void* |run_body |I32 oldscope s |void |call_body |OP *myop|int is_eval s |void* |call_list_body |CV *cv -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -s |void* |vparse_body |va_list args -s |void* |vrun_body |va_list args -s |void* |vcall_body |va_list args -s |void* |vcall_list_body|va_list args -#endif #endif #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT) @@ -1084,9 +1072,6 @@ s |int |div128 |SV *pnum|bool *done #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT) s |OP* |docatch |OP *o s |void* |docatch_body -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -s |void* |vdocatch_body |va_list args -#endif s |OP* |dofindlabel |OP *o|char *label|OP **opstack|OP **oplimit s |OP* |doparseform |SV *sv sn |bool |num_overflow |NV value|I32 fldsize|I32 frcsize @@ -1183,10 +1183,6 @@ #define do_pmop_dump Perl_do_pmop_dump #define do_sv_dump Perl_do_sv_dump #define magic_dump Perl_magic_dump -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -#define default_protect Perl_default_protect -#define vdefault_protect Perl_vdefault_protect -#endif #define reginitcolors Perl_reginitcolors #define sv_2pv_nolen Perl_sv_2pv_nolen #define sv_2pvutf8_nolen Perl_sv_2pvutf8_nolen @@ -1444,20 +1440,6 @@ #ifdef PERL_CORE #define call_list_body S_call_list_body #endif -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -#ifdef PERL_CORE -#define vparse_body S_vparse_body -#endif -#ifdef PERL_CORE -#define vrun_body S_vrun_body -#endif -#ifdef PERL_CORE -#define vcall_body S_vcall_body -#endif -#ifdef PERL_CORE -#define vcall_list_body S_vcall_list_body -#endif -#endif #endif #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT) #ifdef PERL_CORE @@ -1503,11 +1485,6 @@ #ifdef PERL_CORE #define docatch_body S_docatch_body #endif -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -#ifdef PERL_CORE -#define vdocatch_body S_vdocatch_body -#endif -#endif #ifdef PERL_CORE #define dofindlabel S_dofindlabel #endif @@ -3806,9 +3783,6 @@ #define do_pmop_dump(a,b,c) Perl_do_pmop_dump(aTHX_ a,b,c) #define do_sv_dump(a,b,c,d,e,f,g) Perl_do_sv_dump(aTHX_ a,b,c,d,e,f,g) #define magic_dump(a) Perl_magic_dump(aTHX_ a) -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -#define vdefault_protect(a,b,c,d) Perl_vdefault_protect(aTHX_ a,b,c,d) -#endif #define reginitcolors() Perl_reginitcolors(aTHX) #define sv_2pv_nolen(a) Perl_sv_2pv_nolen(aTHX_ a) #define sv_2pvutf8_nolen(a) Perl_sv_2pvutf8_nolen(aTHX_ a) @@ -4066,20 +4040,6 @@ #ifdef PERL_CORE #define call_list_body(a) S_call_list_body(aTHX_ a) #endif -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -#ifdef PERL_CORE -#define vparse_body(a) S_vparse_body(aTHX_ a) -#endif -#ifdef PERL_CORE -#define vrun_body(a) S_vrun_body(aTHX_ a) -#endif -#ifdef PERL_CORE -#define vcall_body(a) S_vcall_body(aTHX_ a) -#endif -#ifdef PERL_CORE -#define vcall_list_body(a) S_vcall_list_body(aTHX_ a) -#endif -#endif #endif #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT) #ifdef PERL_CORE @@ -4125,11 +4085,6 @@ #ifdef PERL_CORE #define docatch_body() S_docatch_body(aTHX) #endif -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -#ifdef PERL_CORE -#define vdocatch_body(a) S_vdocatch_body(aTHX_ a) -#endif -#endif #ifdef PERL_CORE #define dofindlabel(a,b,c,d) S_dofindlabel(aTHX_ a,b,c,d) #endif diff --git a/embedvar.h b/embedvar.h index 3e7d7f67d2..f02b1ffe69 100644 --- a/embedvar.h +++ b/embedvar.h @@ -81,7 +81,6 @@ #define PL_op (vTHX->Top) #define PL_opsave (vTHX->Topsave) #define PL_peepp (vTHX->Tpeepp) -#define PL_protect (vTHX->Tprotect) #define PL_reg_call_cc (vTHX->Treg_call_cc) #define PL_reg_curpm (vTHX->Treg_curpm) #define PL_reg_eval_set (vTHX->Treg_eval_set) @@ -805,7 +804,6 @@ #define PL_Top PL_op #define PL_Topsave PL_opsave #define PL_Tpeepp PL_peepp -#define PL_Tprotect PL_protect #define PL_Treg_call_cc PL_reg_call_cc #define PL_Treg_curpm PL_reg_curpm #define PL_Treg_eval_set PL_reg_eval_set diff --git a/global.sym b/global.sym index 6c004bb18d..43c4d4440a 100644 --- a/global.sym +++ b/global.sym @@ -588,8 +588,6 @@ Perl_do_op_dump Perl_do_pmop_dump Perl_do_sv_dump Perl_magic_dump -Perl_default_protect -Perl_vdefault_protect Perl_reginitcolors Perl_sv_2pv_nolen Perl_sv_2pvutf8_nolen diff --git a/makedef.pl b/makedef.pl index 7da0575b7f..256eddd0b3 100644 --- a/makedef.pl +++ b/makedef.pl @@ -596,14 +596,6 @@ unless ($define{'PERL_COPY_ON_WRITE'}) { )]; } -unless ($define{'PERL_FLEXIBLE_EXCEPTIONS'}) { - skip_symbols [qw( - PL_protect - Perl_default_protect - Perl_vdefault_protect - )]; -} - unless ($define{'USE_REENTRANT_API'}) { skip_symbols [qw( PL_reentrant_buffer @@ -213,10 +213,6 @@ perl_construct(pTHXx) #endif /* Init the real globals (and main thread)? */ if (!PL_linestr) { -#ifdef PERL_FLEXIBLE_EXCEPTIONS - PL_protect = MEMBER_TO_FPTR(Perl_default_protect); /* for exceptions */ -#endif - PL_curcop = &PL_compiling; /* needed by ckWARN, right away */ PL_linestr = NEWSV(65,79); @@ -1176,16 +1172,10 @@ setuid perl scripts securely.\n"); oldscope = PL_scopestack_ix; PL_dowarn = G_WARN_OFF; -#ifdef PERL_FLEXIBLE_EXCEPTIONS - CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vparse_body), env, xsinit); -#else JMPENV_PUSH(ret); -#endif switch (ret) { case 0: -#ifndef PERL_FLEXIBLE_EXCEPTIONS parse_body(env,xsinit); -#endif if (PL_checkav) call_list(oldscope, PL_checkav); ret = 0; @@ -1212,17 +1202,6 @@ setuid perl scripts securely.\n"); return ret; } -#ifdef PERL_FLEXIBLE_EXCEPTIONS -STATIC void * -S_vparse_body(pTHX_ va_list args) -{ - char **env = va_arg(args, char**); - XSINIT_t xsinit = va_arg(args, XSINIT_t); - - return parse_body(env, xsinit); -} -#endif - STATIC void * S_parse_body(pTHX_ char **env, XSINIT_t xsinit) { @@ -1748,21 +1727,14 @@ perl_run(pTHXx) VMSISH_HUSHED = 0; #endif -#ifdef PERL_FLEXIBLE_EXCEPTIONS - redo_body: - CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vrun_body), oldscope); -#else JMPENV_PUSH(ret); -#endif switch (ret) { case 1: cxstack_ix = -1; /* start context stack again */ goto redo_body; case 0: /* normal completion */ -#ifndef PERL_FLEXIBLE_EXCEPTIONS redo_body: run_body(oldscope); -#endif /* FALL THROUGH */ case 2: /* my_exit() */ while (PL_scopestack_ix > oldscope) @@ -1793,16 +1765,6 @@ perl_run(pTHXx) return ret; } -#ifdef PERL_FLEXIBLE_EXCEPTIONS -STATIC void * -S_vrun_body(pTHX_ va_list args) -{ - I32 oldscope = va_arg(args, I32); - - return run_body(oldscope); -} -#endif - STATIC void * S_run_body(pTHX_ I32 oldscope) @@ -2113,19 +2075,11 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) } PL_markstack_ptr++; -#ifdef PERL_FLEXIBLE_EXCEPTIONS - redo_body: - CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_body), - (OP*)&myop, FALSE); -#else JMPENV_PUSH(ret); -#endif switch (ret) { case 0: -#ifndef PERL_FLEXIBLE_EXCEPTIONS redo_body: call_body((OP*)&myop, FALSE); -#endif retval = PL_stack_sp - (PL_stack_base + oldmark); if (!(flags & G_KEEPERR)) sv_setpv(ERRSV,""); @@ -2183,18 +2137,6 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) return retval; } -#ifdef PERL_FLEXIBLE_EXCEPTIONS -STATIC void * -S_vcall_body(pTHX_ va_list args) -{ - OP *myop = va_arg(args, OP*); - int is_eval = va_arg(args, int); - - call_body(myop, is_eval); - return NULL; -} -#endif - STATIC void S_call_body(pTHX_ OP *myop, int is_eval) { @@ -2254,23 +2196,15 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) if (flags & G_KEEPERR) myop.op_flags |= OPf_SPECIAL; -#ifdef PERL_FLEXIBLE_EXCEPTIONS - redo_body: - CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_body), - (OP*)&myop, TRUE); -#else /* fail now; otherwise we could fail after the JMPENV_PUSH but * before a PUSHEVAL, which corrupts the stack after a croak */ TAINT_PROPER("eval_sv()"); JMPENV_PUSH(ret); -#endif switch (ret) { case 0: -#ifndef PERL_FLEXIBLE_EXCEPTIONS redo_body: call_body((OP*)&myop,TRUE); -#endif retval = PL_stack_sp - (PL_stack_base + oldmark); if (!(flags & G_KEEPERR)) sv_setpv(ERRSV,""); @@ -4632,16 +4566,10 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) } else { SAVEFREESV(cv); } -#ifdef PERL_FLEXIBLE_EXCEPTIONS - CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_list_body), cv); -#else JMPENV_PUSH(ret); -#endif switch (ret) { case 0: -#ifndef PERL_FLEXIBLE_EXCEPTIONS call_list_body(cv); -#endif atsv = ERRSV; (void)SvPV(atsv, len); if (len) { @@ -4698,15 +4626,6 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) } } -#ifdef PERL_FLEXIBLE_EXCEPTIONS -STATIC void * -S_vcall_list_body(pTHX_ va_list args) -{ - CV *cv = va_arg(args, CV*); - return call_list_body(cv); -} -#endif - STATIC void * S_call_list_body(pTHX_ CV *cv) { @@ -123,10 +123,6 @@ #define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string) #define CALLREGFREE CALL_FPTR(PL_regfree) -#ifdef PERL_FLEXIBLE_EXCEPTIONS -# define CALLPROTECT CALL_FPTR(PL_protect) -#endif - #ifdef HASATTRIBUTE # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) # define PERL_UNUSED_DECL @@ -766,8 +766,6 @@ END_EXTERN_C #define PL_opsave (*Perl_Topsave_ptr(aTHX)) #undef PL_peepp #define PL_peepp (*Perl_Tpeepp_ptr(aTHX)) -#undef PL_protect -#define PL_protect (*Perl_Tprotect_ptr(aTHX)) #undef PL_reg_call_cc #define PL_reg_call_cc (*Perl_Treg_call_cc_ptr(aTHX)) #undef PL_reg_curpm diff --git a/pod/perlapi.pod b/pod/perlapi.pod index c3f9d98010..39390985e0 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -1699,6 +1699,16 @@ which is shared between threads. =for hackers Found in file util.c +=item savesvpv + +A version of C<savepv()>/C<savepvn() which gets the string to duplicate from +the passed in SV using C<SvPV()> + + char* savesvpv(SV* sv) + +=for hackers +Found in file util.c + =item StructCopy This is an architecture-independent macro to copy one structure to another. diff --git a/pod/perlintern.pod b/pod/perlintern.pod index 50f3d51af9..48a433a8ac 100644 --- a/pod/perlintern.pod +++ b/pod/perlintern.pod @@ -400,6 +400,10 @@ created even in rvalue contexts. C<flags> is not used at present but available for future extension to allow selecting particular classes of magical variable. +Currently assumes that C<name> is NUL terminated (as well as len being valid). +This assumption is met by all callers within the perl core, which all pass +pointers returned by SvPV. + bool is_gv_magical(char *name, STRLEN len, U32 flags) =for hackers @@ -2674,14 +2674,6 @@ S_save_lines(pTHX_ AV *array, SV *sv) } } -#ifdef PERL_FLEXIBLE_EXCEPTIONS -STATIC void * -S_docatch_body(pTHX_ va_list args) -{ - return docatch_body(); -} -#endif - STATIC void * S_docatch_body(pTHX) { @@ -2713,18 +2705,11 @@ S_docatch(pTHX_ OP *o) retop = cxstack[cxstack_ix].blk_eval.retop; cxstack[cxstack_ix].blk_eval.retop = Nullop; -#ifdef PERL_FLEXIBLE_EXCEPTIONS - redo_body: - CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body)); -#else JMPENV_PUSH(ret); -#endif switch (ret) { case 0: -#ifndef PERL_FLEXIBLE_EXCEPTIONS redo_body: docatch_body(); -#endif break; case 3: /* die caught by an inner eval - continue inner loop */ @@ -863,10 +863,6 @@ PERL_CALLCONV void Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o); PERL_CALLCONV void Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm); PERL_CALLCONV void Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim); PERL_CALLCONV void Perl_magic_dump(pTHX_ MAGIC *mg); -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -PERL_CALLCONV void* Perl_default_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, ...); -PERL_CALLCONV void* Perl_vdefault_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, va_list *args); -#endif PERL_CALLCONV void Perl_reginitcolors(pTHX); PERL_CALLCONV char* Perl_sv_2pv_nolen(pTHX_ SV* sv); PERL_CALLCONV char* Perl_sv_2pvutf8_nolen(pTHX_ SV* sv); @@ -1011,12 +1007,6 @@ STATIC void* S_parse_body(pTHX_ char **env, XSINIT_t xsinit); STATIC void* S_run_body(pTHX_ I32 oldscope); STATIC void S_call_body(pTHX_ OP *myop, int is_eval); STATIC void* S_call_list_body(pTHX_ CV *cv); -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -STATIC void* S_vparse_body(pTHX_ va_list args); -STATIC void* S_vrun_body(pTHX_ va_list args); -STATIC void* S_vcall_body(pTHX_ va_list args); -STATIC void* S_vcall_list_body(pTHX_ va_list args); -#endif #endif #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT) @@ -1039,9 +1029,6 @@ STATIC int S_div128(pTHX_ SV *pnum, bool *done); #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT) STATIC OP* S_docatch(pTHX_ OP *o); STATIC void* S_docatch_body(pTHX); -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -STATIC void* S_vdocatch_body(pTHX_ va_list args); -#endif STATIC OP* S_dofindlabel(pTHX_ OP *o, char *label, OP **opstack, OP **oplimit); STATIC OP* S_doparseform(pTHX_ SV *sv); STATIC bool S_num_overflow(NV value, I32 fldsize, I32 frcsize); @@ -24,37 +24,6 @@ #define PERL_IN_SCOPE_C #include "perl.h" -#if defined(PERL_FLEXIBLE_EXCEPTIONS) -void * -Perl_default_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt, - protect_body_t body, ...) -{ - void *ret; - va_list args; - va_start(args, body); - ret = vdefault_protect(pcur_env, excpt, body, &args); - va_end(args); - return ret; -} - -void * -Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt, - protect_body_t body, va_list *args) -{ - int ex; - void *ret; - - JMPENV_PUSH(ex); - if (ex) - ret = NULL; - else - ret = CALL_FPTR(body)(aTHX_ *args); - *excpt = ex; - JMPENV_POP; - return ret; -} -#endif - SV** Perl_stack_grow(pTHX_ SV **sp, SV **p, int n) { @@ -234,10 +234,6 @@ struct jmpenv { Sigjmp_buf je_buf; /* only for use if !je_throw */ int je_ret; /* last exception thrown */ bool je_mustcatch; /* need to call longjmp()? */ -#ifdef PERL_FLEXIBLE_EXCEPTIONS - void (*je_throw)(int v); /* last for bincompat */ - bool je_noset; /* no need for setjmp() */ -#endif }; typedef struct jmpenv JMPENV; @@ -268,116 +264,38 @@ typedef struct jmpenv JMPENV; PL_top_env = &PL_start_env; \ } STMT_END -#ifdef PERL_FLEXIBLE_EXCEPTIONS - /* - * These exception-handling macros are split up to - * ease integration with C++ exceptions. - * - * To use C++ try+catch to catch Perl exceptions, an extension author - * needs to first write an extern "C" function to throw an appropriate - * exception object; typically it will be or contain an integer, - * because Perl's internals use integers to track exception types: - * extern "C" { static void thrower(int i) { throw i; } } + * PERL_FLEXIBLE_EXCEPTIONS + * + * All the flexible exceptions code has been removed. + * See the following threads for details: * - * Then (as shown below) the author needs to use, not the simple - * JMPENV_PUSH, but several of its constitutent macros, to arrange for - * the Perl internals to call thrower() rather than longjmp() to - * report exceptions: + * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-07/msg00378.html + * + * Joshua's original patches (which weren't applied) and discussion: + * + * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01396.html + * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01489.html + * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01491.html + * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01608.html + * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02144.html + * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02998.html + * + * Chip's reworked patch and discussion: + * + * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1999-03/msg00520.html + * + * The flaw in these patches (which went unnoticed at the time) was + * that they moved some code that could potentially die() out of the + * region protected by the setjmp()s. This caused exceptions within + * END blocks and such to not be handled by the correct setjmp(). + * + * The original patches that introduces flexible exceptions were: * - * dJMPENV; - * JMPENV_PUSH_INIT(thrower); - * try { - * ... stuff that may throw exceptions ... - * } - * catch (int why) { // or whatever matches thrower() - * JMPENV_POST_CATCH; - * EXCEPT_SET(why); - * switch (why) { - * ... // handle various Perl exception codes - * } - * } - * JMPENV_POP; // don't forget this! + * http://public.activestate.com/cgi-bin/perlbrowse?patch=3386 + * http://public.activestate.com/cgi-bin/perlbrowse?patch=5162 */ -/* - * Function that catches/throws, and its callback for the - * body of protected processing. - */ -typedef void *(CPERLscope(*protect_body_t)) (pTHX_ va_list); -typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env, - int *, protect_body_t, ...); - -#define dJMPENV JMPENV cur_env; \ - volatile JMPENV *pcur_env = ((cur_env.je_noset = 0),&cur_env) - -#define JMPENV_PUSH_INIT_ENV(ce,THROWFUNC) \ - STMT_START { \ - (ce).je_throw = (THROWFUNC); \ - (ce).je_ret = -1; \ - (ce).je_mustcatch = FALSE; \ - (ce).je_prev = PL_top_env; \ - PL_top_env = &(ce); \ - OP_REG_TO_MEM; \ - } STMT_END - -#define JMPENV_PUSH_INIT(THROWFUNC) JMPENV_PUSH_INIT_ENV(*(JMPENV*)pcur_env,THROWFUNC) - -#define JMPENV_POST_CATCH_ENV(ce) \ - STMT_START { \ - OP_MEM_TO_REG; \ - PL_top_env = &(ce); \ - } STMT_END - -#define JMPENV_POST_CATCH JMPENV_POST_CATCH_ENV(*(JMPENV*)pcur_env) - -#define JMPENV_PUSH_ENV(ce,v) \ - STMT_START { \ - if (!(ce).je_noset) { \ - DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n", \ - ce, PL_top_env)); \ - JMPENV_PUSH_INIT_ENV(ce,NULL); \ - EXCEPT_SET_ENV(ce,PerlProc_setjmp((ce).je_buf, SCOPE_SAVES_SIGNAL_MASK));\ - (ce).je_noset = 1; \ - } \ - else \ - EXCEPT_SET_ENV(ce,0); \ - JMPENV_POST_CATCH_ENV(ce); \ - (v) = EXCEPT_GET_ENV(ce); \ - } STMT_END - -#define JMPENV_PUSH(v) JMPENV_PUSH_ENV(*(JMPENV*)pcur_env,v) - -#define JMPENV_POP_ENV(ce) \ - STMT_START { \ - if (PL_top_env == &(ce)) \ - PL_top_env = (ce).je_prev; \ - } STMT_END - -#define JMPENV_POP JMPENV_POP_ENV(*(JMPENV*)pcur_env) - -#define JMPENV_JUMP(v) \ - STMT_START { \ - OP_REG_TO_MEM; \ - if (PL_top_env->je_prev) { \ - if (PL_top_env->je_throw) \ - PL_top_env->je_throw(v); \ - else \ - PerlProc_longjmp(PL_top_env->je_buf, (v)); \ - } \ - if ((v) == 2) \ - PerlProc_exit(STATUS_NATIVE_EXPORT); \ - PerlIO_printf(Perl_error_log, "panic: top_env\n"); \ - PerlProc_exit(1); \ - } STMT_END - -#define EXCEPT_GET_ENV(ce) ((ce).je_ret) -#define EXCEPT_GET EXCEPT_GET_ENV(*(JMPENV*)pcur_env) -#define EXCEPT_SET_ENV(ce,v) ((ce).je_ret = (v)) -#define EXCEPT_SET(v) EXCEPT_SET_ENV(*(JMPENV*)pcur_env,v) - -#else /* !PERL_FLEXIBLE_EXCEPTIONS */ - #define dJMPENV JMPENV cur_env #define JMPENV_PUSH(v) \ @@ -411,7 +329,5 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env, PerlProc_exit(1); \ } STMT_END -#endif /* PERL_FLEXIBLE_EXCEPTIONS */ - #define CATCH_GET (PL_top_env->je_mustcatch) #define CATCH_SET(v) (PL_top_env->je_mustcatch = (v)) @@ -12178,9 +12178,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_dirty = proto_perl->Tdirty; PL_localizing = proto_perl->Tlocalizing; -#ifdef PERL_FLEXIBLE_EXCEPTIONS - PL_protect = proto_perl->Tprotect; -#endif PL_errors = sv_dup_inc(proto_perl->Terrors, param); PL_hv_fetch_ent_mh = Nullhe; PL_modcount = proto_perl->Tmodcount; @@ -130,9 +130,6 @@ PERLVAR(Tmainstack, AV *) /* the stack when nothing funny is happening */ PERLVAR(Ttop_env, JMPENV *) /* ptr. to current sigjmp() environment */ PERLVAR(Tstart_env, JMPENV) /* empty startup sigjmp() environment */ -#ifdef PERL_FLEXIBLE_EXCEPTIONS -PERLVARI(Tprotect, protect_proc_t, MEMBER_TO_FPTR(Perl_default_protect)) -#endif PERLVARI(Terrors, SV *, Nullsv) /* outstanding queued errors */ /* statics "owned" by various functions */ |