This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove PERL_FLEXIBLE_EXCEPTIONS code.
authorMarcus Holland-Moritz <mhx-perl@gmx.net>
Mon, 10 Jan 2005 19:25:27 +0000 (19:25 +0000)
committerMarcus Holland-Moritz <mhx-perl@gmx.net>
Mon, 10 Jan 2005 19:25:27 +0000 (19:25 +0000)
p4raw-id: //depot/perl@23780

16 files changed:
embed.fnc
embed.h
embedvar.h
global.sym
makedef.pl
perl.c
perl.h
perlapi.h
pod/perlapi.pod
pod/perlintern.pod
pp_ctl.c
proto.h
scope.c
scope.h
sv.c
thrdvar.h

index 231dc14..795f3fe 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -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
diff --git a/embed.h b/embed.h
index 9d22e8d..d5c5e40 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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
 #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
 #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
 #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)
 #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
 #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
index 3e7d7f6..f02b1ff 100644 (file)
@@ -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)
 #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
index 6c004bb..43c4d44 100644 (file)
@@ -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
index 7da0575..256eddd 100644 (file)
@@ -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
diff --git a/perl.c b/perl.c
index 5bcdc74..8accfb8 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -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)
 {
diff --git a/perl.h b/perl.h
index 06e8a13..a36398a 100644 (file)
--- a/perl.h
+++ b/perl.h
 #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
index dddb24f..bcd2623 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -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
index c3f9d98..3939098 100644 (file)
@@ -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.
index 50f3d51..48a433a 100644 (file)
@@ -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
index 4b894fc..06f5c05 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -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 */
diff --git a/proto.h b/proto.h
index 64a6185..f99ab1c 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -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);
diff --git a/scope.c b/scope.c
index af10b71..fe2ceca 100644 (file)
--- a/scope.c
+++ b/scope.c
 #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)
 {
diff --git a/scope.h b/scope.h
index 29bc4c6..8ae6319 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -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))
diff --git a/sv.c b/sv.c
index d750f10..6fc5588 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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;
index 6d5471f..726dbee 100644 (file)
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -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 */