gutsupport for C++ exceptions

	Message-ID: <19990309115157.E7911@perlsupport.com>
	Subject: [PATCH 5.005] Flexible Exceptions

p4raw-id: //depot/perl@3386

1 files changed, 92 insertions, 12 deletions

diff --git a/scope.h b/scope.h
index aa865bf9b4..1502d4f083 100644
--- a/scope.h
+++ b/scope.h
@@ -147,13 +147,41 @@
 
 struct jmpenv {
     struct jmpenv *	je_prev;
-    Sigjmp_buf		je_buf;		
-    int			je_ret;		/* return value of last setjmp() */
-    bool		je_mustcatch;	/* longjmp()s must be caught locally */
+    Sigjmp_buf		je_buf;		/* only for use if !je_throw */
+    int			je_ret;		/* last exception thrown */
+    bool		je_mustcatch;	/* need to call longjmp()? */
+    void		(*je_throw)(int v); /* last for bincompat */
 };
 
 typedef struct jmpenv JMPENV;
 
+/*
+ * Function that catches/throws, and its callback for the
+ *  body of protected processing.
+ */
+typedef void *(CPERLscope(*protect_body_t)) _((va_list args));
+typedef void *(CPERLscope(*protect_proc_t))
+			_((int *except, protect_body_t, ...));
+
+/*
+ * How to build the first jmpenv.
+ *
+ * top_env needs to be non-zero. It points to an area
+ * in which longjmp() stuff is stored, as C callstack
+ * info there at least is thread specific this has to
+ * be per-thread. Otherwise a 'die' in a thread gives
+ * that thread the C stack of last thread to do an eval {}!
+ */
+
+#define JMPENV_BOOTSTRAP \
+    STMT_START {				\
+	PL_start_env.je_prev = NULL;		\
+	PL_start_env.je_throw = NULL;		\
+	PL_start_env.je_ret = -1;		\
+	PL_start_env.je_mustcatch = TRUE;	\
+	PL_top_env = &PL_start_env;		\
+    } STMT_END
+
 #ifdef OP_IN_REGISTER
 #define OP_REG_TO_MEM	PL_opsave = op
 #define OP_MEM_TO_REG	op = PL_opsave
@@ -162,30 +190,82 @@ typedef struct jmpenv JMPENV;
 #define OP_MEM_TO_REG	NOOP
 #endif
 
+/*
+ * 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; } }
+ *
+ * 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:
+ *
+ *    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!
+ */
+
 #define dJMPENV		JMPENV cur_env
-#define JMPENV_PUSH(v) \
+
+#define JMPENV_PUSH_INIT(THROWFUNC) \
     STMT_START {					\
+	cur_env.je_throw = (THROWFUNC);			\
+	cur_env.je_ret = -1;				\
+	cur_env.je_mustcatch = FALSE;			\
 	cur_env.je_prev = PL_top_env;			\
+	PL_top_env = &cur_env;				\
 	OP_REG_TO_MEM;					\
-	cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, 1);	\
+    } STMT_END
+#define JMPENV_POST_CATCH \
+    STMT_START {					\
 	OP_MEM_TO_REG;					\
 	PL_top_env = &cur_env;				\
-	cur_env.je_mustcatch = FALSE;			\
-	(v) = cur_env.je_ret;				\
     } STMT_END
+
+#define JMPENV_PUSH(v) \
+    STMT_START {					\
+	JMPENV_PUSH_INIT(NULL);				\
+	EXCEPT_SET(PerlProc_setjmp(cur_env.je_buf, 1));	\
+	JMPENV_POST_CATCH;				\
+	(v) = EXCEPT_GET;				\
+    } STMT_END
+
 #define JMPENV_POP \
     STMT_START { PL_top_env = cur_env.je_prev; } STMT_END
+
 #define JMPENV_JUMP(v) \
     STMT_START {						\
 	OP_REG_TO_MEM;						\
-	if (PL_top_env->je_prev)					\
-	    PerlProc_longjmp(PL_top_env->je_buf, (v));			\
+	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);				\
+	    PerlProc_exit(STATUS_NATIVE_EXPORT);		\
 	PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");	\
-	PerlProc_exit(1);						\
+	PerlProc_exit(1);					\
     } STMT_END
-   
+
+#define EXCEPT_GET	(cur_env.je_ret)
+#define EXCEPT_SET(v)	(cur_env.je_ret = (v))
+
 #define CATCH_GET	(PL_top_env->je_mustcatch)
 #define CATCH_SET(v)	(PL_top_env->je_mustcatch = (v))