cvsuser 04/06/24 03:12:26
Modified: classes exception.pmc sarray.pmc
include/parrot register.h
src exceptions.c
t/op gc.t
t/pmc exception.t
Log:
fix a DOD bug related to exceptions
Revision Changes Path
1.10 +3 -3 parrot/classes/exception.pmc
Index: exception.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/exception.pmc,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- exception.pmc 22 Feb 2004 17:48:41 -0000 1.9
+++ exception.pmc 24 Jun 2004 10:12:00 -0000 1.10
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: exception.pmc,v 1.9 2004/02/22 17:48:41 mikescott Exp $
+$Id: exception.pmc,v 1.10 2004/06/24 10:12:00 leo Exp $
=head1 NAME
@@ -100,7 +100,7 @@
void init() {
SUPER();
- DYNSELF.set_integer_native(9);
+ DYNSELF.set_integer_native(5);
DYNSELF.set_string_keyed_int(0, NULL);
DYNSELF.set_integer_keyed_int(1, 0);
DYNSELF.set_integer_keyed_int(2, 0);
1.27 +5 -5 parrot/classes/sarray.pmc
Index: sarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/sarray.pmc,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -w -r1.26 -r1.27
--- sarray.pmc 22 Feb 2004 17:48:41 -0000 1.26
+++ sarray.pmc 24 Jun 2004 10:12:00 -0000 1.27
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: sarray.pmc,v 1.26 2004/02/22 17:48:41 mikescott Exp $
+$Id: sarray.pmc,v 1.27 2004/06/24 10:12:00 leo Exp $
=head1 NAME
1.25 +1 -17 parrot/include/parrot/register.h
Index: register.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/register.h,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -w -r1.24 -r1.25
--- register.h 22 Apr 2004 08:55:06 -0000 1.24
+++ register.h 24 Jun 2004 10:12:08 -0000 1.25
@@ -1,7 +1,7 @@
/* register.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: register.h,v 1.24 2004/04/22 08:55:06 leo Exp $
+ * $Id: register.h,v 1.25 2004/06/24 10:12:08 leo Exp $
* Overview:
* Defines the register api
* Data Structure and Algorithms:
@@ -48,22 +48,6 @@
PMC *registers[NUM_REGISTERS/2];
};
-struct IRegChunkBuf {
- struct IRegFrame IRegFrame[FRAMES_PER_CHUNK];
-};
-
-struct NRegChunkBuf {
- struct NRegFrame NRegFrame[FRAMES_PER_CHUNK];
-};
-
-struct SRegChunkBuf {
- struct SRegFrame SRegFrame[FRAMES_PER_CHUNK];
-};
-
-struct PRegChunkBuf {
- struct PRegFrame PRegFrame[FRAMES_PER_CHUNK];
-};
-
struct Stack_Chunk;
struct Parrot_Context;
1.55 +3 -3 parrot/src/exceptions.c
Index: exceptions.c
===================================================================
RCS file: /cvs/public/parrot/src/exceptions.c,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -w -r1.54 -r1.55
--- exceptions.c 23 Apr 2004 09:21:11 -0000 1.54
+++ exceptions.c 24 Jun 2004 10:12:13 -0000 1.55
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: exceptions.c,v 1.54 2004/04/23 09:21:11 jrieks Exp $
+$Id: exceptions.c,v 1.55 2004/06/24 10:12:13 leo Exp $
=head1 NAME
@@ -310,6 +310,8 @@
if (!handler)
return NULL;
cc = (struct Parrot_Sub*)PMC_sub(handler);
+ /* put the continuation ctx in the interpreter */
+ restore_context(interpreter, &cc->ctx);
/* preserve P5 register */
VTABLE_set_pmc_keyed_int(interpreter, exception, 3, REG_PMC(5));
#if 0
@@ -322,8 +324,6 @@
VTABLE_set_pmc_keyed_int(interpreter, exception, 4,
new_ret_continuation_pmc(interpreter, dest));
}
- /* put the continuation ctx in the interpreter */
- restore_context(interpreter, &cc->ctx);
/* put exception object in P5 */
REG_PMC(5) = exception;
if (PObj_get_FLAGS(handler) & PObj_private0_FLAG) {
1.14 +39 -2 parrot/t/op/gc.t
Index: gc.t
===================================================================
RCS file: /cvs/public/parrot/t/op/gc.t,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- gc.t 2 Apr 2004 07:50:42 -0000 1.13
+++ gc.t 24 Jun 2004 10:12:19 -0000 1.14
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: gc.t,v 1.13 2004/04/02 07:50:42 leo Exp $
+# $Id: gc.t,v 1.14 2004/06/24 10:12:19 leo Exp $
=head1 NAME
@@ -17,7 +17,7 @@
=cut
-use Parrot::Test tests => 13;
+use Parrot::Test tests => 14;
output_is( <<'CODE', '1', "sweep 1" );
interpinfo I1, 2 # How many DOD runs have we done already?
@@ -437,3 +437,40 @@
3 * 5 == 15!
OUTPUT
+output_is(<<'CODE', <<OUTPUT, "Recursion and exceptions");
+##PIR##
+# this did segfault with GC_DEBUG
+
+.sub main @MAIN
+ .local int n
+ $P0 = getinterp
+ $P0."recursion_limit"(10)
+ newclass $P0, "b"
+ $I0 = find_type "b"
+ $P0 = new $I0
+ n = $P0."b11"(0)
+ print "ok 1\n"
+ print n
+ print "\n"
+.end
+.namespace ["b"]
+.sub b11 method
+ .param int n
+ .local int n1
+ n1 = n + 1
+ newsub $P0, .Exception_Handler, _catch
+ set_eh $P0
+ n = self."b11"(n1)
+ clear_eh
+ .pcc_begin_return
+ .return n
+ .pcc_end_return
+.end
+.sub _catch
+ set P2, P5["_invoke_cc"]
+ invoke P2
+.end
+CODE
+ok 1
+10
+OUTPUT
1.10 +4 -39 parrot/t/pmc/exception.t
Index: exception.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/exception.t,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- exception.t 22 Jun 2004 14:31:47 -0000 1.9
+++ exception.t 24 Jun 2004 10:12:26 -0000 1.10
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: exception.t,v 1.9 2004/06/22 14:31:47 leo Exp $
+# $Id: exception.t,v 1.10 2004/06/24 10:12:26 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 24;
+use Parrot::Test tests => 23;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "set_eh - clear_eh");
@@ -525,42 +525,10 @@
end
CODE
-output_is(<<'CODE', <<'OUTPUT', "recursion limit RuntimeException");
-##PIR##
-.sub main @MAIN
- .local int n
- sweepoff # XXX DOD troubles
- n = b11(0)
- print "ok 1\n"
- print n
- print "\n"
-.end
-.sub b11
- .param int n
- .local int n1
- n1 = n + 1
- newsub $P0, .Exception_Handler, _catch
- set_eh $P0
- n = P0(n1)
- clear_eh
- .pcc_begin_return
- .return n
- .pcc_end_return
-.end
-.sub _catch
- set P2, P5["_invoke_cc"]
- invoke P2
-.end
-CODE
-ok 1
-1000
-OUTPUT
-
output_is(<<'CODE', <<'OUTPUT', "set recursion limit, method call ");
##PIR##
.sub main @MAIN
.local int n
- sweepoff # XXX DOD troubles
$P0 = getinterp
$P0."recursion_limit"(100)
newclass $P0, "b"
@@ -576,18 +544,15 @@
.param int n
.local int n1
n1 = n + 1
- newsub $P0, .Exception_Handler, _catch
+ newsub $P0, .Exception_Handler, catch
set_eh $P0
n = self."b11"(n1)
clear_eh
+catch:
.pcc_begin_return
.return n
.pcc_end_return
.end
-.sub _catch
- set P2, P5["_invoke_cc"]
- invoke P2
-.end
CODE
ok 1
100
