cvsuser 04/12/08 05:20:47
Modified: include/parrot enums.h exceptions.h stacks.h
ops core.ops ops.num
src exceptions.c objects.c stacks.c
t/pmc exception.t
Log:
pushmark, popmark, pushaction 1 - basic functionality
Revision Changes Path
1.7 +2 -1 parrot/include/parrot/enums.h
Index: enums.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/enums.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- enums.h 22 Apr 2004 08:55:05 -0000 1.6
+++ enums.h 8 Dec 2004 13:20:38 -0000 1.7
@@ -19,7 +19,8 @@
STACK_ENTRY_PMC = 4,
STACK_ENTRY_POINTER = 5,
STACK_ENTRY_DESTINATION = 6,
- STACK_ENTRY_CORO_MARK = 7
+ STACK_ENTRY_MARK = 7,
+ STACK_ENTRY_ACTION = 8
} Stack_entry_type;
typedef enum {
1.52 +9 -1 parrot/include/parrot/exceptions.h
Index: exceptions.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/exceptions.h,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- exceptions.h 18 Oct 2004 01:35:25 -0000 1.51
+++ exceptions.h 8 Dec 2004 13:20:38 -0000 1.52
@@ -1,7 +1,7 @@
/* exceptions.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: exceptions.h,v 1.51 2004/10/18 01:35:25 brentdax Exp $
+ * $Id: exceptions.h,v 1.52 2004/12/08 13:20:38 leo Exp $
* Overview:
* define the internal interpreter exceptions
* Data Structure and Algorithms:
@@ -172,6 +172,14 @@
void do_exception(Parrot_Interp, exception_severity severity, long error);
void new_internal_exception(Parrot_Interp);
+/*
+ * control stack marks and action
+ */
+
+void Parrot_push_mark(Interp *, INTVAL mark);
+void Parrot_pop_mark(Interp *, INTVAL mark);
+void Parrot_push_action(Interp *, PMC *sub);
+
#endif /* PARROT_EXCEPTIONS_H_GUARD */
/*
1.43 +3 -3 parrot/include/parrot/stacks.h
Index: stacks.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/stacks.h,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -r1.42 -r1.43
--- stacks.h 18 Oct 2004 01:35:25 -0000 1.42
+++ stacks.h 8 Dec 2004 13:20:38 -0000 1.43
@@ -1,7 +1,7 @@
/* stacks.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: stacks.h,v 1.42 2004/10/18 01:35:25 brentdax Exp $
+ * $Id: stacks.h,v 1.43 2004/12/08 13:20:38 leo Exp $
* Overview:
* Stack handling routines for Parrot
* Data Structure and Algorithms:
@@ -20,7 +20,7 @@
typedef struct Stack_Entry {
UnionVal entry;
Stack_entry_type entry_type;
- void (*cleanup)(struct Stack_Entry *);
+ void (*cleanup)(Interp *, struct Stack_Entry *);
} Stack_Entry_t;
typedef struct Stack_Chunk {
@@ -38,7 +38,7 @@
/* #define STACK_ITEMSIZE(chunk) PObj_buflen(chunk) */
-typedef void (*Stack_cleanup_method)(Stack_Entry_t *);
+typedef void (*Stack_cleanup_method)(Interp*, Stack_Entry_t *);
#define STACK_CLEANUP_NULL ((Stack_cleanup_method)NULLfunc)
1.380 +29 -0 parrot/ops/core.ops
Index: core.ops
===================================================================
RCS file: /cvs/public/parrot/ops/core.ops,v
retrieving revision 1.379
retrieving revision 1.380
diff -u -r1.379 -r1.380
--- core.ops 27 Nov 2004 11:11:22 -0000 1.379
+++ core.ops 8 Dec 2004 13:20:42 -0000 1.380
@@ -596,6 +596,20 @@
extended exit status, create an exception with severity B<EXCEPT_exit>
and throw it.
+=item B<pushmark>(in INT)
+
+Push a mark labeled $1 onto the control stack.
+
+=item B<popmark>(in INT)
+
+Pop all items off the control stack to the given mark.
+
+=item B<pushaction>(in PMC)
+
+Push the given Sub PMC $1 onto the control stack. If the control stack
+is unwound due to a C<popmark>, subroutine return, or an exception, the
+subroutine will be invoked.
+
=cut
inline op push_eh(labelconst INT) {
@@ -631,6 +645,21 @@
restart NEXT();
}
+inline op pushmark(in INT) {
+ Parrot_push_mark(interpreter, $1);
+ goto NEXT();
+}
+
+inline op popmark(in INT) {
+ Parrot_pop_mark(interpreter, $1);
+ goto NEXT();
+}
+
+inline op pushaction(in PMC) {
+ Parrot_push_action(interpreter, $1);
+ goto NEXT();
+}
+
=back
=cut
1.52 +5 -0 parrot/ops/ops.num
Index: ops.num
===================================================================
RCS file: /cvs/public/parrot/ops/ops.num,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- ops.num 7 Dec 2004 17:24:53 -0000 1.51
+++ ops.num 8 Dec 2004 13:20:42 -0000 1.52
@@ -1358,3 +1358,8 @@
pow_p_p_p 1328
pow_p_p_i 1329
pow_p_p_ic 1330
+pushaction_p 1331
+popmark_i 1332
+popmark_ic 1333
+pushmark_i 1334
+pushmark_ic 1335
1.66 +83 -28 parrot/src/exceptions.c
Index: exceptions.c
===================================================================
RCS file: /cvs/public/parrot/src/exceptions.c,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -r1.65 -r1.66
--- exceptions.c 25 Nov 2004 09:28:05 -0000 1.65
+++ exceptions.c 8 Dec 2004 13:20:45 -0000 1.66
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: exceptions.c,v 1.65 2004/11/25 09:28:05 leo Exp $
+$Id: exceptions.c,v 1.66 2004/12/08 13:20:45 leo Exp $
=head1 NAME
@@ -128,17 +128,28 @@
/*
-=item C<void
-push_exception(Parrot_Interp interpreter, PMC *handler)>
+=item C<void push_exception(Interp * interpreter, PMC *handler)>
Add the exception handler on the stack.
+=item C<void Parrot_push_action(Interp * interpreter, PMC *sub)>
+
+Push an action handler onto the control stack.
+
+=item C<void Parrot_push_mark(Interp * interpreter, INTVAL mark)>
+
+Push a cleanup mark onto the control stack.
+
+=item C<void Parrot_pop_mark(Interp * interpreter, INTVAL mark)>
+
+Pop items off the control stack up to the mark.
+
=cut
*/
void
-push_exception(Parrot_Interp interpreter, PMC *handler)
+push_exception(Interp * interpreter, PMC *handler)
{
if (handler->vtable->base_type != enum_class_Exception_Handler)
PANIC("Tried to set_eh a non Exception_Handler");
@@ -146,10 +157,50 @@
STACK_ENTRY_PMC, STACK_CLEANUP_NULL);
}
+static void
+run_cleanup_action(Interp *interpreter, Stack_Entry_t *e)
+{
+ PMC *sub = UVal_pmc(e->entry);
+ Parrot_runops_fromc_args(interpreter, sub, "vI", 0);
+}
+
+void
+Parrot_push_action(Interp * interpreter, PMC *sub)
+{
+ if (sub->vtable->base_type != enum_class_Sub)
+ internal_exception(1, "Tried to push a non Sub PMC action");
+ stack_push(interpreter, &interpreter->ctx.control_stack, sub,
+ STACK_ENTRY_ACTION, run_cleanup_action);
+}
+
+void
+Parrot_push_mark(Interp * interpreter, INTVAL mark)
+{
+ stack_push(interpreter, &interpreter->ctx.control_stack, &mark,
+ STACK_ENTRY_MARK, STACK_CLEANUP_NULL);
+}
+
+void
+Parrot_pop_mark(Interp * interpreter, INTVAL mark)
+{
+ Stack_Entry_t *e;
+ do {
+ e = stack_entry(interpreter, interpreter->ctx.control_stack, 0);
+ if (!e)
+ internal_exception(1, "mark not found");
+ (void)stack_pop(interpreter, &interpreter->ctx.control_stack,
+ NULL, e->entry_type);
+ if (e->entry_type == STACK_ENTRY_MARK) {
+ if (UVal_int(e->entry) == mark)
+ return;
+ }
+ } while (1);
+}
+
/*
=item C<static PMC *
-find_exception_handler(Parrot_Interp interpreter, PMC *exception)>
+find_exception_handler(Interp * interpreter, PMC *exception)>
Find the exception handler for C<exception>.
@@ -158,7 +209,7 @@
*/
static PMC *
-find_exception_handler(Parrot_Interp interpreter, PMC *exception)
+find_exception_handler(Interp * interpreter, PMC *exception)
{
PMC *handler;
STRING *message;
@@ -173,6 +224,10 @@
interpreter->ctx.control_stack, 0);
if (!e)
break;
+ if (e->entry_type == STACK_ENTRY_ACTION) {
+ PMC *sub = UVal_pmc(e->entry);
+ Parrot_runops_fromc_args(interpreter, sub, "vI", 1);
+ }
(void)stack_pop(interpreter, &interpreter->ctx.control_stack,
NULL, e->entry_type);
if (e->entry_type == STACK_ENTRY_PMC) {
@@ -229,7 +284,7 @@
/*
=item C<void
-pop_exception(Parrot_Interp interpreter)>
+pop_exception(Interp * interpreter)>
Pops the topmost exception handler off the stack.
@@ -238,7 +293,7 @@
*/
void
-pop_exception(Parrot_Interp interpreter)
+pop_exception(Interp * interpreter)
{
Stack_entry_type type;
PMC *handler;
@@ -254,7 +309,7 @@
/*
=item C<PMC*
-new_c_exception_handler(Parrot_Interp interpreter, Parrot_exception *jb)>
+new_c_exception_handler(Interp * interpreter, Parrot_exception *jb)>
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
@@ -265,7 +320,7 @@
*/
PMC*
-new_c_exception_handler(Parrot_Interp interpreter, Parrot_exception *jb)
+new_c_exception_handler(Interp * interpreter, Parrot_exception *jb)
{
PMC *handler = pmc_new(interpreter, enum_class_Exception_Handler);
/*
@@ -279,7 +334,7 @@
/*
=item C<void
-push_new_c_exception_handler(Parrot_Interp interpreter, Parrot_exception
*jb)>
+push_new_c_exception_handler(Interp * interpreter, Parrot_exception *jb)>
Pushes an new C exception handler onto the stack.
@@ -288,7 +343,7 @@
*/
void
-push_new_c_exception_handler(Parrot_Interp interpreter, Parrot_exception *jb)
+push_new_c_exception_handler(Interp * interpreter, Parrot_exception *jb)
{
push_exception(interpreter, new_c_exception_handler(interpreter, jb));
}
@@ -296,7 +351,7 @@
/*
=item C<void *
-throw_exception(Parrot_Interp interpreter, PMC *exception, void *dest)>
+throw_exception(Interp * interpreter, PMC *exception, void *dest)>
Throw the exception.
@@ -305,7 +360,7 @@
*/
void *
-throw_exception(Parrot_Interp interpreter, PMC *exception, void *dest)
+throw_exception(Interp * interpreter, PMC *exception, void *dest)
{
PMC *handler;
void *address;
@@ -343,7 +398,7 @@
/*
=item C<void *
-rethrow_exception(Parrot_Interp interpreter, PMC *exception)>
+rethrow_exception(Interp * interpreter, PMC *exception)>
Rethrow the exception.
@@ -352,7 +407,7 @@
*/
void *
-rethrow_exception(Parrot_Interp interpreter, PMC *exception)
+rethrow_exception(Interp * interpreter, PMC *exception)
{
PMC *handler;
void *address;
@@ -370,7 +425,7 @@
/*
=item C<void
-rethrow_c_exception(Parrot_Interp interpreter)>
+rethrow_c_exception(Interp * interpreter)>
Return back to runloop, assumes exception is still in C<REG_PMC(5)> and
that this is called from within a handler setup with C<new_c_exception>
@@ -380,7 +435,7 @@
*/
void
-rethrow_c_exception(Parrot_Interp interpreter)
+rethrow_c_exception(Interp * interpreter)
{
PMC *exception, *handler, *p5;
Parrot_exception *the_exception = interpreter->exceptions;
@@ -406,7 +461,7 @@
/*
=item C<static size_t
-dest2offset(Parrot_Interp interpreter, opcode_t *dest)>
+dest2offset(Interp * interpreter, opcode_t *dest)>
Translate an absolute bytecode location to an offset used for resuming
after an exception had occured.
@@ -416,7 +471,7 @@
*/
static size_t
-dest2offset(Parrot_Interp interpreter, opcode_t *dest)
+dest2offset(Interp * interpreter, opcode_t *dest)
{
size_t offset;
/* translate an absolute location in byte_code to an offset
@@ -435,7 +490,7 @@
/*
=item C<static opcode_t *
-create_exception(Parrot_Interp interpreter)>
+create_exception(Interp * interpreter)>
Create an exception.
@@ -444,7 +499,7 @@
*/
static opcode_t *
-create_exception(Parrot_Interp interpreter)
+create_exception(Interp * interpreter)
{
PMC *exception; /* exception object */
opcode_t *dest; /* absolute address of handler */
@@ -480,7 +535,7 @@
/*
-=item C<size_t handle_exception(Parrot_Interp interpreter)>
+=item C<size_t handle_exception(Interp * interpreter)>
Handle an exception.
@@ -489,7 +544,7 @@
*/
size_t
-handle_exception(Parrot_Interp interpreter)
+handle_exception(Interp * interpreter)
{
opcode_t *dest; /* absolute address of handler */
@@ -500,7 +555,7 @@
/*
=item C<void
-new_internal_exception(Parrot_Interp interpreter)>
+new_internal_exception(Interp * interpreter)>
Create a new internal exception buffer, either by allocating it or by
getting one from the free list.
@@ -510,7 +565,7 @@
*/
void
-new_internal_exception(Parrot_Interp interpreter)
+new_internal_exception(Interp * interpreter)
{
Parrot_exception *the_exception;
@@ -529,7 +584,7 @@
/*
=item C<void
-do_exception(Parrot_Interp interpreter,
+do_exception(Interp * interpreter,
exception_severity severity, long error)>
Called from interrupt code. Does a C<longjmp> in front of the runloop,
@@ -540,7 +595,7 @@
*/
void
-do_exception(Parrot_Interp interpreter,
+do_exception(Interp * interpreter,
exception_severity severity, long error)
{
Parrot_exception *the_exception = interpreter->exceptions;
1.127 +1 -2 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.126
retrieving revision 1.127
diff -u -r1.126 -r1.127
--- objects.c 7 Dec 2004 14:42:06 -0000 1.126
+++ objects.c 8 Dec 2004 13:20:45 -0000 1.127
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.126 2004/12/07 14:42:06 leo Exp $
+$Id: objects.c,v 1.127 2004/12/08 13:20:45 leo Exp $
=head1 NAME
@@ -1136,7 +1136,6 @@
/*
* quick'n'dirty method cache
- * TODO: integrate NCI meth lookup
* TODO: use a hash if method_name is not constant
* i.e. from obj.$Sreg(args)
* If this hash is implemented mark it during DOD
1.80 +7 -6 parrot/src/stacks.c
Index: stacks.c
===================================================================
RCS file: /cvs/public/parrot/src/stacks.c,v
retrieving revision 1.79
retrieving revision 1.80
diff -u -r1.79 -r1.80
--- stacks.c 30 Sep 2004 14:34:14 -0000 1.79
+++ stacks.c 8 Dec 2004 13:20:45 -0000 1.80
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: stacks.c,v 1.79 2004/09/30 14:34:14 leo Exp $
+$Id: stacks.c,v 1.80 2004/12/08 13:20:45 leo Exp $
=head1 NAME
@@ -259,11 +259,13 @@
/* Store our thing */
switch (type) {
case STACK_ENTRY_INT:
+ case STACK_ENTRY_MARK:
UVal_int(entry->entry) = *(Intval *)thing;
break;
case STACK_ENTRY_FLOAT:
UVal_num(entry->entry) = *(Floatval *)thing;
break;
+ case STACK_ENTRY_ACTION:
case STACK_ENTRY_PMC:
UVal_pmc(entry->entry) = (PMC *)thing;
break;
@@ -272,7 +274,6 @@
break;
case STACK_ENTRY_POINTER:
case STACK_ENTRY_DESTINATION:
- case STACK_ENTRY_CORO_MARK:
UVal_ptr(entry->entry) = thing;
break;
default:
@@ -307,8 +308,8 @@
}
/* Cleanup routine? */
- if (type != STACK_ENTRY_CORO_MARK && entry->cleanup) {
- (*entry->cleanup) (entry);
+ if (entry->cleanup) {
+ (*entry->cleanup) (interpreter, entry);
}
/* Sometimes the caller doesn't care what the value was */
@@ -318,12 +319,14 @@
/* Snag the value */
switch (type) {
+ case STACK_ENTRY_MARK:
case STACK_ENTRY_INT:
*(Intval *)where = UVal_int(entry->entry);
break;
case STACK_ENTRY_FLOAT:
*(Floatval *)where = UVal_num(entry->entry);
break;
+ case STACK_ENTRY_ACTION:
case STACK_ENTRY_PMC:
*(PMC **)where = UVal_pmc(entry->entry);
break;
@@ -332,7 +335,6 @@
break;
case STACK_ENTRY_POINTER:
case STACK_ENTRY_DESTINATION:
- case STACK_ENTRY_CORO_MARK:
*(void **)where = UVal_ptr(entry->entry);
break;
default:
@@ -393,7 +395,6 @@
switch (entry->entry_type) {
case STACK_ENTRY_POINTER:
case STACK_ENTRY_DESTINATION:
- case STACK_ENTRY_CORO_MARK:
return UVal_ptr(entry->entry);
default:
return (void *) UVal_pmc(entry->entry);
1.15 +58 -9 parrot/t/pmc/exception.t
Index: exception.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/exception.t,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- exception.t 25 Nov 2004 11:15:37 -0000 1.14
+++ exception.t 8 Dec 2004 13:20:47 -0000 1.15
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: exception.t,v 1.14 2004/11/25 11:15:37 leo Exp $
+# $Id: exception.t,v 1.15 2004/12/08 13:20:47 leo Exp $
=head1 NAME
@@ -16,12 +16,11 @@
=cut
-use Parrot::Test tests => 24;
+use Parrot::Test tests => 28;
use Test::More;
-output_is(<<'CODE', <<'OUTPUT', "set_eh - clear_eh");
- newsub P20, .Exception_Handler, _handler
- set_eh P20
+output_is(<<'CODE', <<'OUTPUT', "push_eh - clear_eh");
+ push_eh _handler
print "ok 1\n"
clear_eh
print "ok 2\n"
@@ -33,11 +32,9 @@
ok 2
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "set_eh - throw");
+output_is(<<'CODE', <<'OUTPUT', "push_eh - throw");
print "main\n"
- newsub P20, .Exception_Handler, _handler
- set_eh P20
-
+ push_eh _handler
new P30, .Exception
throw P30
print "not reached\n"
@@ -584,3 +581,55 @@
OUTPUT
1;
+output_is(<<'CODE', <<'OUTPUT', "pushmark");
+ pushmark 10
+ print "ok 1\n"
+ popmark 10
+ print "ok 2\n"
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "pushmark nested");
+ pushmark 10
+ pushmark 11
+ print "ok 1\n"
+ popmark 11
+ popmark 10
+ print "ok 2\n"
+ end
+CODE
+ok 1
+ok 2
+OUTPUT
+
+output_like(<<'CODE', <<'OUTPUT', "pushmark - pop wrong one");
+ pushmark 10
+ print "ok 1\n"
+ popmark 500
+ print "never\n"
+ end
+CODE
+/mark not found/
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "pushaction");
+ pushmark 10
+ print "ok 1\n"
+ .const .Sub P10 = "action"
+ pushaction P10
+ print "ok 2\n"
+ popmark 10
+ print "ok 3\n"
+ end
+.pcc_sub action:
+ print "in action\n"
+ returncc
+CODE
+ok 1
+ok 2
+in action
+ok 3
+OUTPUT
