cvsuser 03/10/23 08:03:37
Modified: classes exception_handler.pmc
. exceptions.c
include/parrot exceptions.h
t/src extend.t
Log:
catch a PASM exception in C code
Revision Changes Path
1.6 +4 -3 parrot/classes/exception_handler.pmc
Index: exception_handler.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/exception_handler.pmc,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- exception_handler.pmc 25 Aug 2003 09:46:23 -0000 1.5
+++ exception_handler.pmc 23 Oct 2003 15:03:30 -0000 1.6
@@ -1,7 +1,7 @@
/* exception_handler.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: exception_handler.pmc,v 1.5 2003/08/25 09:46:23 leo Exp $
+ * $Id: exception_handler.pmc,v 1.6 2003/10/23 15:03:30 leo Exp $
* Overview:
* This is the exception_handler class
* Data Structure and Algorithms:
@@ -19,8 +19,9 @@
pmclass Exception_Handler extends Continuation {
- INTVAL type() { /* pmc2c.pl doesn't like empty classes */
- return SELF->vtable->base_type;
+ void init() {
+ PObj_get_FLAGS(SELF) &= ~PObj_private0_FLAG;
+ SUPER();
}
}
1.38 +25 -1 parrot/exceptions.c
Index: exceptions.c
===================================================================
RCS file: /cvs/public/parrot/exceptions.c,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -w -r1.37 -r1.38
--- exceptions.c 15 Oct 2003 08:31:20 -0000 1.37
+++ exceptions.c 23 Oct 2003 15:03:33 -0000 1.38
@@ -1,7 +1,7 @@
/* exceptions.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: exceptions.c,v 1.37 2003/10/15 08:31:20 leo Exp $
+ * $Id: exceptions.c,v 1.38 2003/10/23 15:03:33 leo Exp $
* Overview:
* define the internal interpreter exceptions
* Data Structure and Algorithms:
@@ -159,6 +159,21 @@
STACK_ENTRY_PMC);
}
+/*
+ * generate an exception handler, that catches PASM level exceptions
+ * inside a C function
+ * This could be a separate class too, for now just a private flag
+ * bit is set
+ */
+PMC*
+new_c_exception_handler(Parrot_Interp interpreter, Parrot_exception *jb)
+{
+ PMC *handler = pmc_new(interpreter, enum_class_Exception_Handler);
+ PObj_get_FLAGS(handler) |= PObj_private0_FLAG;
+ handler->cache.struct_val = jb;
+ return handler;
+}
+
void *
throw_exception(Parrot_Interp interpreter, PMC *exception, void *dest)
{
@@ -183,6 +198,15 @@
restore_context(interpreter, &cc->ctx);
/* put exception object in P5 */
REG_PMC(5) = exception;
+ if (PObj_get_FLAGS(handler) & PObj_private0_FLAG) {
+ /* its a C exception handler */
+ Parrot_exception *jb = (Parrot_exception *) handler->cache.struct_val;
+#ifdef PARROT_HAS_HEADER_SETJMP
+ longjmp(jb->destination, 1);
+#else
+ return NULL; /* we are lost */
+#endif
+ }
/* return the address of the handler */
return handler->cache.struct_val;
}
1.39 +4 -1 parrot/include/parrot/exceptions.h
Index: exceptions.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/exceptions.h,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -w -r1.38 -r1.39
--- exceptions.h 29 Aug 2003 11:30:19 -0000 1.38
+++ exceptions.h 23 Oct 2003 15:03:35 -0000 1.39
@@ -1,7 +1,7 @@
/* exceptions.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: exceptions.h,v 1.38 2003/08/29 11:30:19 leo Exp $
+ * $Id: exceptions.h,v 1.39 2003/10/23 15:03:35 leo Exp $
* Overview:
* define the internal interpreter exceptions
* Data Structure and Algorithms:
@@ -101,6 +101,9 @@
size_t handle_exception(Parrot_Interp);
void do_exception(exception_severity severity, long error);
+
+PMC* new_c_exception_handler(Parrot_Interp, Parrot_exception *jb);
+
#endif
/*
1.7 +56 -1 parrot/t/src/extend.t
Index: extend.t
===================================================================
RCS file: /cvs/public/parrot/t/src/extend.t,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- extend.t 22 Oct 2003 08:07:09 -0000 1.6
+++ extend.t 23 Oct 2003 15:03:37 -0000 1.7
@@ -1,7 +1,7 @@
#! perl -w
# Tests the extension API
-use Parrot::Test tests => 11;
+use Parrot::Test tests => 12;
use Parrot::Config;
c_output_is(<<'CODE', <<'OUTPUT', "set/get_intreg");
@@ -378,6 +378,61 @@
back
OUTPUT
+open S, ">$temp.pasm" or die "Can't write $temp.pasm";
+print S <<'EOF';
+ .pcc_sub _sub1:
+ printerr "in sub1\n"
+ new_pad 0
+ find_lex P2, "no_such_var"
+ printerr "never\n"
+ invoke P1
+EOF
+close S;
+# compile to pbc
+system(".$PConfig{slash}parrot$PConfig{exe} -o $temp.pbc $temp.pasm");
+
+c_output_is(<<'CODE', <<'OUTPUT', "call a parrot sub");
+
+#include <stdio.h>
+/* have to cheat because of missing extend interfaces */
+/* #include "parrot/extend.h" */
+#include "parrot/parrot.h"
+#include "parrot/embed.h"
+
+/* also both the test PASM and main print to stderr
+ * so that buffering in PIO isn't and issue
+ */
+
+int main(int argc, char* argv[]) {
+ Parrot_Interp interpreter;
+ struct PackFile *pf;
+ PMC *key, *sub, *arg;
+ Parrot_exception jb;
+
+ interpreter = Parrot_new();
+ pf = Parrot_readbc(interpreter, "temp.pbc");
+ Parrot_loadbc(interpreter, pf);
+ key = key_new_cstring(interpreter, "_sub1");
+ sub = VTABLE_get_pmc_keyed(interpreter,
+ interpreter->perl_stash->stash_hash, key);
+ if (setjmp(jb.destination)) {
+ fprintf(stderr, "caught\n");
+ }
+ else {
+ PMC *handler = new_c_exception_handler(interpreter, &jb);
+ push_exception(interpreter, handler);
+ Parrot_call(interpreter, sub, 0);
+ }
+ fprintf(stderr, "back\n");
+ return 0;
+}
+CODE
+in sub1
+caught
+back
+OUTPUT
+
unlink "$temp.pasm", "$temp.pbc";
+
1;
